[m-rev.] for review: user-defined operator tables
Simon Taylor
stayl at cs.mu.OZ.AU
Tue Nov 6 00:57:46 AEDT 2001
Estimated hours taken: 4
Allow user-defined operator precedence tables for parser__read_term
and term_io__write_term.
library/ops.m:
Define a typeclass `op_table' with methods for accessing
operator precedence tables.
Define a type `ops__mercury_op_table', representing the
standard Mercury operator table.
Make `ops__mercury_op_table' an instance of `op_table'.
Define `ops__table' as equivalent to `ops__mercury_op_table'
(it's obsolete, but we can't mark types as obsolete).
Rename `ops__init_op_table' as `ops__init_mercury_op_table',
mark ops__init_op_table as obsolete
library/parser.m:
library/term_io.m:
Add variants of `parser__read_term' and `term_io__write_term'
which take an operator precedence table.
Don't hard-code the maximum priority and argument priority.
Use the `op_table' methods to find those.
Make the priority of operator terms (X `op` Y) 1, not 100.
The reference manual states that operator terms have
the highest precedence possible.
This change slows down a program which does nothing but
parse terms by a bit under 5%, less for writing.
library/bitmap.m:
library/hash_table.m:
Fix a few places where parentheses are required because
operator terms now have the lowest possible priority.
`rem' is an operator -- it doesn't need backquotes.
compiler/mercury_to_mercury.m:
library/io.m:
Rename `ops__init_op_table' to `ops__init_mercury_op_table'.
Pass the `op_table' to `ops__max_priority'.
NEWS:
doc/reference_manual.texi:
Document the changes.
Add operator terms to the operator table.
In the "Terms" section of the reference manual, use the same
terminology to describe operator terms as is used in the
"Builtin Operators" section.
samples/Mmakefile:
samples/README:
samples/calculator2.m:
An example program.
tests/hard_coded/term_io_test.exp:
tests/invalid/func_errors.err_exp:
tests/invalid/inst_list_dup.err_exp:
tests/invalid/predmode.err_exp:
tests/invalid/some_err.exp:
`term_io__write_term' now has the same argument priority
behaviour as `parser__read_term', so remove some unnecessary
parentheses from the output.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.224
diff -u -u -r1.224 NEWS
--- NEWS 4 Nov 2001 09:06:33 -0000 1.224
+++ NEWS 5 Nov 2001 12:55:23 -0000
@@ -54,6 +54,14 @@
return `[|]' rather than `.' for lists, and calls to std_util__construct
which construct lists may need to be updated.
+* ops.m now defines a typeclass which can be used to define operator
+ precedence tables for use by parser.m and term_io.m. See
+ samples/calculator2.m for an example program.
+
+ The `ops__table' type has been renamed `ops__mercury_op_table'.
+ `ops__init_op_table' has been renamed `ops__init_mercury_op_table'.
+ `ops__max_priority' is now a function taking an operator table argument.
+
* The predicates and functions in int.m, float, math.m and array.m now
generate exceptions rather than program aborts on domain errors and
out-of-bounds array accesses. There are new functions
@@ -121,6 +129,11 @@
This change will break some existing programs, but that is easily fixed
by adding any necessary `:- import_module' or `:- use_module' declarations.
+
+* We've fixed a bug in the parser. The Mercury Language Reference Manual
+ states that operator terms (X `op` Y) have the lowest possible priority,
+ however in the implementation they had a higher priority than the unary
+ prefix operator `^'.
* We've added a new optimization pass -- constraint propagation.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.196
diff -u -u -r1.196 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 4 Nov 2001 17:22:57 -0000 1.196
+++ compiler/mercury_to_mercury.m 4 Nov 2001 17:26:16 -0000
@@ -3286,31 +3286,31 @@
:- mode mercury_op(in) is semidet.
mercury_op(Op) :-
- ops__lookup_op(ops__init_op_table, Op).
+ ops__lookup_op(ops__init_mercury_op_table, Op).
:- pred mercury_binary_prefix_op(string).
:- mode mercury_binary_prefix_op(in) is semidet.
mercury_binary_prefix_op(Op) :-
- ops__lookup_binary_prefix_op(ops__init_op_table, Op, _, _, _).
+ ops__lookup_binary_prefix_op(ops__init_mercury_op_table, Op, _, _, _).
:- pred mercury_infix_op(string).
:- mode mercury_infix_op(in) is semidet.
mercury_infix_op(Op) :-
- ops__lookup_infix_op(ops__init_op_table, Op, _, _, _).
+ ops__lookup_infix_op(ops__init_mercury_op_table, Op, _, _, _).
:- pred mercury_unary_prefix_op(string).
:- mode mercury_unary_prefix_op(in) is semidet.
mercury_unary_prefix_op(Op) :-
- ops__lookup_prefix_op(ops__init_op_table, Op, _, _).
+ ops__lookup_prefix_op(ops__init_mercury_op_table, Op, _, _).
:- pred mercury_unary_postfix_op(string).
:- mode mercury_unary_postfix_op(in) is semidet.
mercury_unary_postfix_op(Op) :-
- ops__lookup_postfix_op(ops__init_op_table, Op, _, _).
+ ops__lookup_postfix_op(ops__init_mercury_op_table, Op, _, _).
%-----------------------------------------------------------------------------%
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.221
diff -u -u -r1.221 reference_manual.texi
--- doc/reference_manual.texi 3 Nov 2001 18:48:42 -0000 1.221
+++ doc/reference_manual.texi 5 Nov 2001 12:47:39 -0000
@@ -370,7 +370,7 @@
be used as an operator in this way. If @var{fun} is a variable or name,
then a term of the form @code{@var{X} `@var{fun}` @var{Y}} is equivalent to
@code{@var{fun}(@var{X}, @var{Y})}. The operator is treated as having the
-highest precedence possible and is left associative.
+lowest priority possible and is left associative (@pxref{Builtin Operators}).
A parenthesized term is just an open parenthesis
followed by a term and a close parenthesis.
@@ -412,6 +412,7 @@
Operator Specifier Priority
+`@var{op}` yfx 1 @footnote{Operator term (@pxref{Terms}).}
^ xfy 99
^ fx 100
** xfy 200
Index: library/bitmap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/bitmap.m,v
retrieving revision 1.5
diff -u -u -r1.5 bitmap.m
--- library/bitmap.m 24 Oct 2001 07:27:40 -0000 1.5
+++ library/bitmap.m 5 Nov 2001 12:05:02 -0000
@@ -237,7 +237,7 @@
flip(BM, I) =
( if in_range(BM, I)
- then BM ^ elem(int_offset(I)) := BM ^ elem(int_offset(I)) `xor` bitmask(I)
+ then BM ^ elem(int_offset(I)) := (BM ^ elem(int_offset(I))) `xor` bitmask(I)
else throw(software_error("bitmap__flip: out of range"))
).
@@ -250,7 +250,7 @@
BM ^ elem(int_offset(I)) := BM ^ elem(int_offset(I)) /\ \bitmask(I).
unsafe_flip(BM, I) =
- BM ^ elem(int_offset(I)) := BM ^ elem(int_offset(I)) `xor` bitmask(I).
+ BM ^ elem(int_offset(I)) := (BM ^ elem(int_offset(I))) `xor` bitmask(I).
% ---------------------------------------------------------------------------- %
Index: library/hash_table.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/hash_table.m,v
retrieving revision 1.2
diff -u -u -r1.2 hash_table.m
--- library/hash_table.m 24 Oct 2001 07:27:40 -0000 1.2
+++ library/hash_table.m 5 Nov 2001 12:10:35 -0000
@@ -271,7 +271,7 @@
(HT ^ hash_pred)(K, Hash1a, Hash2a),
int__abs(Hash1a, Hash1),
int__abs(Hash2a, Hash2),
- H0 = Hash1 `rem` HT ^ num_buckets,
+ H0 = Hash1 rem HT ^ num_buckets,
Delta = Hash2 + Hash2 + 1, % Have to ensure it's odd and non-zero.
H = find_slot_2(HT, K, H0, Delta).
@@ -287,7 +287,7 @@
else if HT ^ keys ^ elem(H0) = K then
H = H0
else
- H1 = (H0 + Delta) `rem` HT ^ num_buckets,
+ H1 = (H0 + Delta) rem HT ^ num_buckets,
H = find_slot_2(HT, K, H1, Delta)
).
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.234
diff -u -u -r1.234 io.m
--- library/io.m 17 Oct 2001 05:10:37 -0000 1.234
+++ library/io.m 3 Nov 2001 16:58:22 -0000
@@ -2095,8 +2095,8 @@
io__write_univ(Univ).
io__write_univ(Univ) -->
- { ops__max_priority(MaxPriority) },
- io__write_univ(Univ, MaxPriority + 1).
+ io__get_op_table(OpTable),
+ io__write_univ(Univ, ops__max_priority(OpTable) + 1).
:- pred io__write_univ(univ, ops__priority, io__state, io__state).
:- mode io__write_univ(in, in, di, uo) is det.
@@ -2274,8 +2274,7 @@
(
{ Args = [] },
{ ops__lookup_op(OpTable, Functor) },
- { ops__max_priority(MaxPriority) },
- { Priority =< MaxPriority }
+ { Priority =< ops__max_priority(OpTable) }
->
io__write_char('('),
term_io__quote_atom(Functor),
@@ -2860,10 +2859,9 @@
io__init_state -->
io__gc_init(type_of(StreamNames), type_of(Globals)),
{ map__init(StreamNames) },
- { ops__init_op_table(OpTable) },
{ type_to_univ("<globals>", Globals) },
io__set_stream_names(StreamNames),
- io__set_op_table(OpTable),
+ io__set_op_table(ops__init_mercury_op_table),
io__set_globals(Globals),
io__insert_std_stream_names.
@@ -2958,8 +2956,7 @@
% XXX design flaw with regard to unique modes and
% io__get_op_table
-io__get_op_table(OpTable) -->
- { ops__init_op_table(OpTable) }.
+io__get_op_table(ops__init_mercury_op_table) --> [].
io__set_op_table(_OpTable) --> [].
Index: library/ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/ops.m,v
retrieving revision 1.35
diff -u -u -r1.35 ops.m
--- library/ops.m 4 Nov 2001 12:08:52 -0000 1.35
+++ library/ops.m 5 Nov 2001 13:43:53 -0000
@@ -8,49 +8,75 @@
% main author: fjh.
% stability: low.
%
-% Here's where we maintain the table of current operators.
+% This module exports a typeclass `ops__op_table' which is used to define
+% operator precedence tables for use by `parser__read_term_with_op_table'
+% and `term_io__write_term_with_op_table'.
%
-% XXX In the current implementation the table is fixed and cannot be
-% modified at run-time.
+% It also exports an instance `ops__mercury_op_table' which implements the
+% Mercury operator table defined in the Mercury Language Reference Manual.
+%
+% See samples/calculator2.m for an example program.
+%
+% XXX In the current implementation the table of Mercury operators
+% is fixed and cannot be modified at run-time.
%
%-----------------------------------------------------------------------------%
:- module ops.
:- interface.
-:- type ops__table.
+:- typeclass ops__op_table(Table) where [
- % create an ops_table with the standard Mercury operators.
-:- pred ops__init_op_table(ops__table).
-:- mode ops__init_op_table(uo) is det.
+ % Check whether a string is the name of an infix operator,
+ % and if it is, return its precedence and associativity.
+ pred ops__lookup_infix_op(Table, string, ops__priority,
+ ops__assoc, ops__assoc),
+ mode ops__lookup_infix_op(in, in, out, out, out) is semidet,
+
+ % Check whether a string is the name of a prefix operator,
+ % and if it is, return its precedence and associativity.
+ pred ops__lookup_prefix_op(Table, string, ops__priority, ops__assoc),
+ mode ops__lookup_prefix_op(in, in, out, out) is semidet,
+
+ % Check whether a string is the name of a binary prefix
+ % operator, and if it is, return its precedence and
+ % associativity.
+ pred ops__lookup_binary_prefix_op(Table, string,
+ ops__priority, ops__assoc, ops__assoc),
+ mode ops__lookup_binary_prefix_op(in, in, out, out, out) is semidet,
+
+ % Check whether a string is the name of a postfix operator,
+ % and if it is, return its precedence and associativity.
+ pred ops__lookup_postfix_op(Table, string, ops__priority, ops__assoc),
+ mode ops__lookup_postfix_op(in, in, out, out) is semidet,
+
+ % Check whether a string is the name of an operator
+ pred ops__lookup_op(Table, string),
+ mode ops__lookup_op(in, in) is semidet,
+
+ % Returns the highest priority number (the lowest is zero).
+ func ops__max_priority(Table) = ops__priority,
+
+ % The maximum priority of an operator appearing
+ % as the top-level functor of an argument of a compound
+ % term.
+ %
+ % This will generally be the precendence of `,/2' less one.
+ % If `,/2' does not appear in the op_table,
+ % `ops__max_priority' plus one may be a reasonable value.
+ func ops__arg_priority(Table) = ops__priority
+].
-:- func ops__init_op_table = ops__table.
+%-----------------------------------------------------------------------------%
- % check whether a string is the name of an infix operator,
- % and if it is, return its precedence and associativity.
-:- pred ops__lookup_infix_op(ops__table, string, ops__priority,
- ops__assoc, ops__assoc).
-:- mode ops__lookup_infix_op(in, in, out, out, out) is semidet.
-
- % check whether a string is the name of a prefix operator,
- % and if it is, return its precedence and associativity.
-:- pred ops__lookup_prefix_op(ops__table, string, ops__priority, ops__assoc).
-:- mode ops__lookup_prefix_op(in, in, out, out) is semidet.
-
- % check whether a string is the name of a binary prefix operator,
- % and if it is, return its precedence and associativity.
-:- pred ops__lookup_binary_prefix_op(ops__table, string,
- ops__priority, ops__assoc, ops__assoc).
-:- mode ops__lookup_binary_prefix_op(in, in, out, out, out) is semidet.
-
- % check whether a string is the name of a postfix operator,
- % and if it is, return its precedence and associativity.
-:- pred ops__lookup_postfix_op(ops__table, string, ops__priority, ops__assoc).
-:- mode ops__lookup_postfix_op(in, in, out, out) is semidet.
-
- % check whether a string is the name of an operator
-:- pred ops__lookup_op(ops__table, string).
-:- mode ops__lookup_op(in, in) is semidet.
+ % The table of Mercury operators.
+ % See the "Builtin Operators" section of the "Syntax" chapter
+ % of the Mercury Language Reference Manual for details.
+:- type ops__mercury_op_table.
+:- instance ops__op_table(ops__mercury_op_table).
+
+:- func ops__init_mercury_op_table = ops__mercury_op_table.
+:- mode ops__init_mercury_op_table = uo is det.
%-----------------------------------------------------------------------------%
@@ -58,14 +84,11 @@
% with a high "priority". For example, given that `+' has
% priority 500 and `*' has priority 400, the term `2 * X + Y'
% would parse as `(2 * X) + Y'.
+ %
+ % The lowest priority is 0.
+ % Operator terms (X `op` Y) have priority 1.
:- type ops__priority == int.
- % Returns the highest priority number (the lowest is zero).
-:- func ops__max_priority = ops__priority.
-
-:- pred ops__max_priority(ops__priority).
-:- mode ops__max_priority(out) is det.
-
%-----------------------------------------------------------------------------%
% An ops__specifier describes what structure terms
@@ -99,13 +122,28 @@
:- implementation.
-:- type ops__table ---> ops__table. % XXX
+% Anything below here is not documented in the library reference manual.
- % ops__category is used to index the op_table so that
- % lookups are semidet rather than nondet.
- % Prefix and binary_prefix operators have ops__category `before'.
- % Infix and postfix operators have ops__category `after'.
-:- type ops__category ---> before ; after.
+:- interface.
+
+ %
+ % The Mercury operator table used to be the only one allowed.
+ % The old names are no longer appropriate.
+ %
+
+:- type ops__table == ops__mercury_op_table.
+
+ % create an op_table with the standard Mercury operators.
+:- pred ops__init_op_table(ops__table).
+:- mode ops__init_op_table(uo) is det.
+:- pragma obsolete(ops__init_op_table/1).
+
+:- func ops__init_op_table = ops__table.
+:- pragma obsolete(ops__init_op_table/0).
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
ops__op_specifier_to_class(fx, prefix(x)).
ops__op_specifier_to_class(fy, prefix(y)).
@@ -118,29 +156,80 @@
ops__op_specifier_to_class(fyx, binary_prefix(y,x)).
ops__op_specifier_to_class(fxy, binary_prefix(x,y)).
-ops__lookup_infix_op(_OpTable, Name, Priority, LeftAssoc, RightAssoc) :-
+:- type ops__mercury_op_table ---> ops__mercury_op_table.
+
+ % ops__category is used to index the op_table so that
+ % lookups are semidet rather than nondet.
+ % Prefix and binary_prefix operators have ops__category `before'.
+ % Infix and postfix operators have ops__category `after'.
+:- type ops__category ---> before ; after.
+
+ops__init_mercury_op_table = ops__mercury_op_table.
+
+:- instance ops__op_table(ops__mercury_op_table) where [
+ pred(ops__lookup_infix_op/5) is ops__lookup_mercury_infix_op,
+ pred(ops__lookup_prefix_op/4) is ops__lookup_mercury_prefix_op,
+ pred(ops__lookup_binary_prefix_op/5) is
+ ops__lookup_mercury_binary_prefix_op,
+ pred(ops__lookup_postfix_op/4) is ops__lookup_mercury_postfix_op,
+ pred(ops__lookup_op/2) is ops__lookup_mercury_op,
+ func(ops__max_priority/1) is ops__mercury_max_priority,
+ func(ops__arg_priority/1) is ops__mercury_arg_priority
+].
+
+:- pred ops__lookup_mercury_infix_op(mercury_op_table, string, ops__priority,
+ ops__assoc, ops__assoc).
+:- mode ops__lookup_mercury_infix_op(in, in, out, out, out) is semidet.
+
+ops__lookup_mercury_infix_op(_OpTable, Name, Priority,
+ LeftAssoc, RightAssoc) :-
ops__op_table(Name, after, Specifier, Priority),
- ops__op_specifier_to_class(Specifier,
- infix(LeftAssoc, RightAssoc)).
+ ops__op_specifier_to_class(Specifier, infix(LeftAssoc, RightAssoc)).
-ops__lookup_prefix_op(_OpTable, Name, Priority, LeftAssoc) :-
+:- pred ops__lookup_mercury_prefix_op(mercury_op_table,
+ string, ops__priority, ops__assoc).
+:- mode ops__lookup_mercury_prefix_op(in, in, out, out) is semidet.
+
+ops__lookup_mercury_prefix_op(_OpTable, Name, Priority, LeftAssoc) :-
ops__op_table(Name, before, Specifier, Priority),
ops__op_specifier_to_class(Specifier, prefix(LeftAssoc)).
-ops__lookup_binary_prefix_op(_OpTable, Name, Priority, LeftAssoc, RightAssoc) :-
+:- pred ops__lookup_mercury_binary_prefix_op(mercury_op_table, string,
+ ops__priority, ops__assoc, ops__assoc).
+:- mode ops__lookup_mercury_binary_prefix_op(in, in, out, out, out) is semidet.
+
+ops__lookup_mercury_binary_prefix_op(_OpTable, Name, Priority, LeftAssoc,
+ RightAssoc) :-
ops__op_table(Name, before, Specifier, Priority),
ops__op_specifier_to_class(Specifier,
binary_prefix(LeftAssoc, RightAssoc)).
-ops__lookup_postfix_op(_OpTable, Name, Priority, LeftAssoc) :-
+:- pred ops__lookup_mercury_postfix_op(mercury_op_table,
+ string, ops__priority, ops__assoc).
+:- mode ops__lookup_mercury_postfix_op(in, in, out, out) is semidet.
+
+ops__lookup_mercury_postfix_op(_OpTable, Name, Priority, LeftAssoc) :-
ops__op_table(Name, after, Specifier, Priority),
ops__op_specifier_to_class(Specifier, postfix(LeftAssoc)).
-ops__lookup_op(_OpTable, Name) :-
+:- pred ops__lookup_mercury_op(mercury_op_table, string).
+:- mode ops__lookup_mercury_op(in, in) is semidet.
+
+ops__lookup_mercury_op(_OpTable, Name) :-
ops__op_table(Name, _, _, _).
- % Changes here may require changes to doc/transition_guide.texi
- % and doc/reference_manual.texi.
+:- func ops__mercury_max_priority(mercury_op_table) = ops__priority.
+
+ops__mercury_max_priority(_Table) = 1200.
+
+:- func ops__mercury_arg_priority(mercury_op_table) = ops__priority.
+
+ % XXX ISO prolog syntax would require us to change this to 999,
+ % but we need bug-for-bug compatibility with the NU-Prolog parser
+ % in order to support e.g. `::' in args.
+ops__mercury_arg_priority(_Table) = 1201.
+
+ % Changes here may require changes to doc/reference_manual.texi.
:- pred ops__op_table(string, ops__category, ops__specifier, ops__priority).
:- mode ops__op_table(in, in, out, out) is semidet.
:- mode ops__op_table(in, out, out, out) is nondet.
@@ -238,13 +327,8 @@
% (*) means that the operator is not useful in Mercury
% and is provided only for compatibility.
-% (NYI) means that the operator is reserved for some Not Yet Implemented
-% future purpose
-
-ops__init_op_table(ops__table).
-ops__init_op_table = ops__table.
-ops__max_priority(ops__max_priority).
-ops__max_priority = 1200.
+ops__init_op_table(ops__mercury_op_table).
+ops__init_op_table = ops__mercury_op_table.
%-----------------------------------------------------------------------------%
Index: library/parser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/parser.m,v
retrieving revision 1.37
diff -u -u -r1.37 parser.m
--- library/parser.m 25 Sep 2001 09:37:03 -0000 1.37
+++ library/parser.m 5 Nov 2001 13:46:33 -0000
@@ -34,7 +34,7 @@
:- module parser.
:- interface.
-:- import_module io, term_io, lexer.
+:- import_module io, ops, term_io, lexer.
%-----------------------------------------------------------------------------%
%
@@ -44,7 +44,14 @@
:- pred parser__read_term(read_term(T), io__state, io__state).
:- mode parser__read_term(out, di, uo) is det.
% parser__read_term(Result):
-% Reads a term from the current input stream.
+% Reads a Mercury term from the current input stream.
+
+:- pred parser__read_term_with_op_table(Ops, read_term(T),
+ io__state, io__state) <= op_table(Ops).
+:- mode parser__read_term_with_op_table(in, out, di, uo) is det.
+% parser__read_term_with_op_table(Result):
+% Reads a term from the current input stream, using the
+% given op_table to interpret the operators.
:- pred parser__read_term(string, read_term(T), io__state, io__state).
:- mode parser__read_term(in, out, di, uo) is det.
@@ -55,6 +62,12 @@
% This interface is used to support the `:- pragma source_file'
% directive.
+:- pred parser__read_term_with_op_table(Ops, string, read_term(T),
+ io__state, io__state) <= op_table(Ops).
+:- mode parser__read_term_with_op_table(in, in, out, di, uo) is det.
+% parser__read_term_with_op_table(Ops, FileName, Result):
+% As above but using the given op_table.
+
%-----------------------------------------------------------------------------%
%
% parser__read_term_from_string/{4,6}:
@@ -73,27 +86,47 @@
:- mode parser__read_term_from_string(in, in, out, out) is det.
% parser__read_term_from_string(FileName, String, EndPos, Term).
+:- pred parser__read_term_from_string_with_op_table(Ops, string,
+ string, posn, read_term(T)) <= op_table(Ops).
+:- mode parser__read_term_from_string_with_op_table(in, in,
+ in, out, out) is det.
+% parser__read_term_from_string_with_op_table(Ops, FileName,
+% String, EndPos, Term).
+
:- pred parser__read_term_from_string(string, string, int, posn, posn,
read_term(T)).
:- mode parser__read_term_from_string(in, in, in, in, out, out) is det.
% parser__read_term_from_string(FileName, String, MaxOffset, StartPos,
-% EndPos, Term).
+% EndPos, Term).
+
+:- pred parser__read_term_from_string_with_op_table(Ops, string, string,
+ int, posn, posn, read_term(T)) <= op_table(Ops).
+:- mode parser__read_term_from_string_with_op_table(in, in, in,
+ in, in, out, out) is det.
+% parser__read_term_from_string_with_op_table(Ops, FileName, String,
+% MaxOffset, StartPos, EndPos, Term).
%-----------------------------------------------------------------------------%
%
-% parser__parse_tokens/3:
+% parser__parse_tokens/{3,4}:
% Parses a list of tokens.
:- pred parser__parse_tokens(string, token_list, read_term(T)).
:- mode parser__parse_tokens(in, in, out) is det.
% parser__parse_tokens(FileName, TokenList, Result):
+:- pred parser__parse_tokens_with_op_table(Ops, string,
+ token_list, read_term(T)) <= op_table(Ops).
+:- mode parser__parse_tokens_with_op_table(in, in, in, out) is det.
+ % parser__parse_tokens(FileName, TokenList, Result):
+
%-----------------------------------------------------------------------------%
:- implementation.
+
:- import_module string, char, int, float, bool, list, std_util, require.
:- import_module map, term, varset.
-:- import_module lexer, ops.
+:- import_module lexer.
:- type parse(T)
---> ok(T)
@@ -103,30 +136,53 @@
parser__read_term(Result) -->
io__input_stream_name(FileName),
- parser__read_term(FileName, Result).
+ parser__read_term_with_op_table(ops__init_mercury_op_table,
+ FileName, Result).
+
+parser__read_term_with_op_table(Ops, Result) -->
+ io__input_stream_name(FileName),
+ parser__read_term_with_op_table(Ops, FileName, Result).
parser__read_term(FileName, Result) -->
+ parser__read_term_with_op_table(ops__init_mercury_op_table,
+ FileName, Result).
+
+parser__read_term_with_op_table(Ops, FileName, Result) -->
lexer__get_token_list(Tokens),
- { parser__parse_tokens(FileName, Tokens, Result) }.
+ { parser__parse_tokens_with_op_table(Ops, FileName, Tokens, Result) }.
parser__read_term_from_string(FileName, String, EndPos, Result) :-
+ parser__read_term_from_string_with_op_table(ops__init_mercury_op_table,
+ FileName, String, EndPos, Result).
+
+parser__read_term_from_string_with_op_table(Ops, FileName, String,
+ EndPos, Result) :-
string__length(String, Len),
StartPos = posn(1, 0, 0),
- parser__read_term_from_string(FileName, String, Len, StartPos, EndPos,
- Result).
+ parser__read_term_from_string_with_op_table(Ops, FileName, String, Len,
+ StartPos, EndPos, Result).
-parser__read_term_from_string(FileName, String, Len, StartPos, EndPos,
- Result) :-
+parser__read_term_from_string(FileName, String, Len,
+ StartPos, EndPos, Result) :-
+ parser__read_term_from_string_with_op_table(ops__init_mercury_op_table,
+ FileName, String, Len, StartPos, EndPos, Result).
+
+parser__read_term_from_string_with_op_table(Ops, FileName, String, Len,
+ StartPos, EndPos, Result) :-
lexer__string_get_token_list(String, Len, Tokens, StartPos, EndPos),
- parser__parse_tokens(FileName, Tokens, Result).
+ parser__parse_tokens_with_op_table(Ops, FileName, Tokens, Result).
%-----------------------------------------------------------------------------%
parser__parse_tokens(FileName, Tokens, Result) :-
+ parser__parse_tokens_with_op_table(ops__init_mercury_op_table,
+ FileName, Tokens, Result).
+
+parser__parse_tokens_with_op_table(Ops, FileName, Tokens, Result) :-
( Tokens = token_nil ->
Result = eof
;
- parser__init_state(FileName, Tokens, ParserState0),
+ parser__init_state(Ops, FileName, Tokens, ParserState0),
parser__parse_whole_term(Term, ParserState0, ParserState),
parser__final_state(ParserState, VarSet, LeftOverTokens),
parser__check_for_errors(Term, VarSet,
@@ -204,8 +260,8 @@
parser__check_for_bad_token(Tokens, Message, LineNum)
).
-:- pred parser__parse_whole_term(parse(term(T)),
- parser__state(T), parser__state(T)).
+:- pred parser__parse_whole_term(parse(term(T)), parser__state(Ops, T),
+ parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_whole_term(out, in, out) is det.
parser__parse_whole_term(Term) -->
@@ -223,26 +279,24 @@
-:- pred parser__parse_term(parse(term(T)), parser__state(T), parser__state(T)).
+:- pred parser__parse_term(parse(term(T)), parser__state(Ops, T),
+ parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_term(out, in, out) is det.
parser__parse_term(Term) -->
- parser__parse_term_2(1201, no, Term).
+ parser__get_ops_table(OpTable),
+ parser__parse_term_2(ops__max_priority(OpTable) + 1, no, Term).
-:- pred parser__parse_arg(parse(term(T)), parser__state(T), parser__state(T)).
+:- pred parser__parse_arg(parse(term(T)), parser__state(Ops, T),
+ parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_arg(out, in, out) is det.
parser__parse_arg(Term) -->
- parser__parse_term_2(1201, yes, Term).
-
- % XXX I think ISO prolog syntax would require us to
- % change that to
- % parser__parse_term(999, no, Term).
- % The above is because we need bug-for-bug compatibility
- % with the NU-Prolog parser in order to support e.g. `::' in args.
+ parser__get_ops_table(OpTable),
+ parser__parse_term_2(ops__arg_priority(OpTable), yes, Term).
:- pred parser__parse_term_2(int, bool, parse(term(T)),
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_term_2(in, in, out, in, out) is det.
parser__parse_term_2(MaxPriority, IsArg, Term) -->
@@ -256,7 +310,7 @@
).
:- pred parser__parse_left_term(int, bool, int, parse(term(T)),
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_left_term(in, in, out, out, in, out) is det.
parser__parse_left_term(MaxPriority, IsArg, OpPriority, Term) -->
@@ -351,7 +405,7 @@
).
:- pred parser__parse_rest(int, bool, int, term(T), parse(term(T)),
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_rest(in, in, in, in, out, in, out) is det.
parser__parse_rest(MaxPriority, IsArg, LeftPriority, LeftTerm, Term) -->
@@ -383,7 +437,7 @@
),
parser__get_token(name("`"), _),
- { OpPriority = 100 },
+ { OpPriority = 1 },
{ LeftAssoc = y },
{ RightAssoc = x }
;
@@ -430,7 +484,7 @@
%-----------------------------------------------------------------------------%
:- pred parser__parse_simple_term(token, token_context, int, parse(term(T)),
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_simple_term(in, in, in, out, in, out) is det.
parser__parse_simple_term(Token, Context, Priority, Term) -->
@@ -446,7 +500,7 @@
% term --> name("-") integer % priority 0
% term --> name("-") float % priority 0
% term --> atom(NonOp) % priority 0
- % term --> atom(Op) % priority 1201
+ % term --> atom(Op) % priority `max_priority' + 1
% atom --> name
% atom --> open_list, close_list
% atom --> open_curly, close_curly
@@ -461,7 +515,7 @@
% term --> term, op % with various conditions
:- pred parser__parse_simple_term_2(token, token_context, int, parse(term(T)),
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_simple_term_2(in, in, in, out, in, out) is semidet.
parser__parse_simple_term_2(name(Atom), Context, Prec, Term) -->
@@ -479,7 +533,7 @@
;
parser__get_ops_table(OpTable),
{ ops__lookup_op(OpTable, Atom) ->
- Prec >= 1201
+ Prec > ops__max_priority(OpTable)
;
true
},
@@ -565,7 +619,8 @@
).
:- pred parser__check_for_higher_order_term(parse(term(T)), token_context,
- parse(term(T)), parser__state(T), parser__state(T)).
+ parse(term(T)), parser__state(Ops, T),
+ parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__check_for_higher_order_term(in, in, out, in, out) is det.
parser__check_for_higher_order_term(Term0, Context, Term) -->
@@ -593,7 +648,7 @@
).
:- pred parser__parse_special_atom(string, term__context, parse(term(T)),
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_special_atom(in, in, out, in, out) is det.
parser__parse_special_atom(Atom, TermContext, Term) -->
@@ -611,7 +666,8 @@
{ Term = ok(term__functor(term__atom(Atom), [], TermContext)) }
).
-:- pred parser__parse_list(parse(term(T)), parser__state(T), parser__state(T)).
+:- pred parser__parse_list(parse(term(T)), parser__state(Ops, T),
+ parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_list(out, in, out) is det.
parser__parse_list(List) -->
@@ -661,7 +717,7 @@
).
:- pred parser__parse_args(parse(list(term(T))),
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__parse_args(out, in, out) is det.
parser__parse_args(List) -->
@@ -696,10 +752,10 @@
% Routines that manipulate the parser state.
-:- type parser__state(T)
+:- type parser__state(Ops, T) % <= op_table(Ops)
---> parser__state(
string, % the name of the stream being parsed
- ops__table, % the current set of operators
+ Ops, % the current set of operators
varset(T), % the names of the variables in the
% term being parsed
token_list, % the remaining tokens
@@ -717,7 +773,8 @@
% it was some other sort of error, so issue the usual
% error message.
-:- pred parser__unexpected(string, parse(U), parser__state(T), parser__state(T)).
+:- pred parser__unexpected(string, parse(U),
+ parser__state(Ops, T), parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__unexpected(in, out, in, out) is det.
parser__unexpected(UsualMessage, Error) -->
@@ -728,7 +785,7 @@
).
:- pred parser__unexpected_tok(token, token_context, string, parse(U),
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__unexpected_tok(in, in, in, out, in, out) is det.
parser__unexpected_tok(Token, Context, UsualMessage, Error) -->
@@ -751,7 +808,8 @@
%-----------------------------------------------------------------------------%
-:- pred parser__error(string, parse(U), parser__state(T), parser__state(T)).
+:- pred parser__error(string, parse(U), parser__state(Ops, T),
+ parser__state(Ops, T)).
:- mode parser__error(in, out, in, out) is det.
parser__error(Message, error(Message, Tokens), ParserState, ParserState) :-
@@ -784,16 +842,16 @@
%-----------------------------------------------------------------------------%
-:- pred parser__init_state(string, token_list, parser__state(T)).
-:- mode parser__init_state(in, in, out) is det.
+:- pred parser__init_state(Ops, string, token_list,
+ parser__state(Ops, T)) <= op_table(Ops).
+:- mode parser__init_state(in, in, in, out) is det.
-parser__init_state(FileName, Tokens, ParserState) :-
- ops__init_op_table(OpTable),
+parser__init_state(Ops, FileName, Tokens, ParserState) :-
varset__init(VarSet),
map__init(Names),
- ParserState = parser__state(FileName, OpTable, VarSet, Tokens, Names).
+ ParserState = parser__state(FileName, Ops, VarSet, Tokens, Names).
-:- pred parser__final_state(parser__state(T), varset(T), token_list).
+:- pred parser__final_state(parser__state(Ops, T), varset(T), token_list).
:- mode parser__final_state(in, out, out) is det.
parser__final_state(parser__state(_FileName, _OpTable, VarSet, TokenList,
@@ -801,14 +859,14 @@
%-----------------------------------------------------------------------------%
-:- pred parser__get_token(token, parser__state(T), parser__state(T)).
+:- pred parser__get_token(token, parser__state(Ops, T), parser__state(Ops, T)).
:- mode parser__get_token(out, in, out) is semidet.
parser__get_token(Token) -->
parser__get_token(Token, _Context).
:- pred parser__get_token(token, token_context,
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)).
:- mode parser__get_token(out, out, in, out) is semidet.
:- mode parser__get_token(in, in, out, in) is det.
@@ -818,21 +876,21 @@
Tokens0 = token_cons(Token, Context, Tokens).
:- pred parser__unget_token(token, token_context,
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)).
:- mode parser__unget_token(in, in, in, out) is det.
:- mode parser__unget_token(out, out, out, in) is semidet.
parser__unget_token(Token, Context, ParseState0, ParseState) :-
parser__get_token(Token, Context, ParseState, ParseState0).
-:- pred parser__peek_token(token, parser__state(T), parser__state(T)).
+:- pred parser__peek_token(token, parser__state(Ops, T), parser__state(Ops, T)).
:- mode parser__peek_token(out, in, out) is semidet.
parser__peek_token(Token) -->
parser__peek_token(Token, _Context).
:- pred parser__peek_token(token, token_context,
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)).
:- mode parser__peek_token(out, out, in, out) is semidet.
parser__peek_token(Token, Context) -->
@@ -841,7 +899,8 @@
%-----------------------------------------------------------------------------%
-:- pred parser__add_var(string, var(T), parser__state(T), parser__state(T)).
+:- pred parser__add_var(string, var(T), parser__state(Ops, T),
+ parser__state(Ops, T)).
:- mode parser__add_var(in, out, in, out) is det.
parser__add_var(VarName, Var,
@@ -859,7 +918,8 @@
map__det_insert(Names0, VarName, Var, Names)
).
-:- pred parser__get_ops_table(ops__table, parser__state(T), parser__state(T)).
+:- pred parser__get_ops_table(Ops, parser__state(Ops, T),
+ parser__state(Ops, T)) <= op_table(Ops).
:- mode parser__get_ops_table(out, in, out) is det.
parser__get_ops_table(OpTable) -->
@@ -884,7 +944,7 @@
Priority < MaxPriority.
:- pred parser__get_term_context(token_context, term__context,
- parser__state(T), parser__state(T)).
+ parser__state(Ops, T), parser__state(Ops, T)).
:- mode parser__get_term_context(in, out, in, out) is det.
parser__get_term_context(TokenContext, TermContext) -->
Index: library/term_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term_io.m,v
retrieving revision 1.63
diff -u -u -r1.63 term_io.m
--- library/term_io.m 18 Oct 2001 10:29:01 -0000 1.63
+++ library/term_io.m 3 Nov 2001 18:46:24 -0000
@@ -16,7 +16,7 @@
:- module term_io.
:- interface.
-:- import_module char, io, varset, term.
+:- import_module char, io, varset, ops, term.
% External interface: exported predicates
@@ -41,21 +41,37 @@
:- pred term_io__read_term(read_term(T), io__state, io__state).
:- mode term_io__read_term(out, di, uo) is det.
-
% term_io__read_term(Result, IO0, IO1).
% Read a term from standard input. Similar to NU-Prolog
% read_term/2, except that resulting term is in the ground
% representation. Binds Result to either `eof',
% `term(VarSet, Term)', or `error(Message, LineNumber)'.
+:- pred term_io__read_term_with_op_table(Ops, read_term(T),
+ io__state, io__state) <= op_table(Ops).
+:- mode term_io__read_term_with_op_table(in, out, di, uo) is det.
+% As above, except uses the given operator table
+% instead of the standard Mercury operators.
+
:- pred term_io__write_term(varset(T), term(T), io__state, io__state).
:- mode term_io__write_term(in, in, di, uo) is det.
% Writes a term to standard output.
+:- pred term_io__write_term_with_op_table(Ops, varset(T), term(T),
+ io__state, io__state) <= op_table(Ops).
+:- mode term_io__write_term_with_op_table(in, in, in, di, uo) is det.
+% As above, except uses the given operator table
+% instead of the standard Mercury operators.
+
:- pred term_io__write_term_nl(varset(T), term(T), io__state, io__state).
:- mode term_io__write_term_nl(in, in, di, uo) is det.
% As above, except it appends a period and new-line.
+:- pred term_io__write_term_nl_with_op_table(Ops, varset(T), term(T),
+ io__state, io__state) <= op_table(Ops).
+:- mode term_io__write_term_nl_with_op_table(in, in, in, di, uo) is det.
+% As above, except it appends a period and new-line.
+
:- pred term_io__write_constant(const, io__state, io__state).
:- mode term_io__write_constant(in, di, uo) is det.
% Writes a constant (integer, float, string, or atom)
@@ -68,6 +84,12 @@
:- mode term_io__write_variable(in, in, di, uo) is det.
% Writes a variable to stdout.
+:- pred term_io__write_variable_with_op_table(Ops, var(T), varset(T),
+ io__state, io__state) <= op_table(Ops).
+:- mode term_io__write_variable_with_op_table(in, in, in, di, uo) is det.
+% As above, except uses the given operator table
+% instead of the standard Mercury operators.
+
:- pred term_io__quote_string(string, io__state, io__state).
:- mode term_io__quote_string(in, di, uo) is det.
% Given a string S, write S in double-quotes, with characters
@@ -138,10 +160,14 @@
:- implementation.
:- import_module bool, std_util, require, list, string, int, char.
-:- import_module lexer, parser, ops.
+:- import_module lexer, parser.
term_io__read_term(Result) -->
- parser__read_term(Result).
+ io__get_op_table(Ops),
+ term_io__read_term_with_op_table(Ops, Result).
+
+term_io__read_term_with_op_table(Ops, Result) -->
+ parser__read_term_with_op_table(Ops, Result).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -167,17 +193,21 @@
% the infrastructure for the second is present in the code.
term_io__write_variable(Variable, VarSet) -->
- term_io__write_variable_2(Variable, VarSet, 0, _, _).
+ io__get_op_table(Ops),
+ term_io__write_variable_with_op_table(Ops, Variable, VarSet).
+
+term_io__write_variable_with_op_table(Ops, Variable, VarSet) -->
+ term_io__write_variable_2(Ops, Variable, VarSet, 0, _, _).
-:- pred term_io__write_variable_2(var(T), varset(T), int, varset(T), int,
- io__state, io__state).
-:- mode term_io__write_variable_2(in, in, in, out, out, di, uo) is det.
+:- pred term_io__write_variable_2(Ops, var(T), varset(T), int, varset(T), int,
+ io__state, io__state) <= op_table(Ops).
+:- mode term_io__write_variable_2(in, in, in, in, out, out, di, uo) is det.
-term_io__write_variable_2(Id, VarSet0, N0, VarSet, N) -->
+term_io__write_variable_2(Ops, Id, VarSet0, N0, VarSet, N) -->
(
{ varset__search_var(VarSet0, Id, Val) }
->
- term_io__write_term_2(Val, VarSet0, N0, VarSet, N)
+ term_io__write_term_2(Ops, Val, VarSet0, N0, VarSet, N)
;
{ varset__search_name(VarSet0, Id, Name) }
->
@@ -202,40 +232,45 @@
% for all unnamed variables with N starting at 0.
term_io__write_term(VarSet, Term) -->
- term_io__write_term_2(Term, VarSet, 0, _, _).
+ io__get_op_table(Ops),
+ term_io__write_term_with_op_table(Ops, VarSet, Term).
+
+term_io__write_term_with_op_table(Ops, VarSet, Term) -->
+ term_io__write_term_2(Ops, Term, VarSet, 0, _, _).
-:- pred term_io__write_term_2(term(T), varset(T), int, varset(T), int,
- 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, VarSet0, N0, VarSet, N) -->
- { ops__max_priority(MaxPriority) },
- term_io__write_term_3(Term, MaxPriority + 1, VarSet0, N0, VarSet, N).
-
-:- pred term_io__write_arg_term(term(T), varset(T), int, varset(T), int,
- io__state, io__state).
-:- mode term_io__write_arg_term(in, in, in, out, out, di, uo) is det.
-
-term_io__write_arg_term(Term, VarSet0, N0, VarSet, N) -->
- { ArgPriority = 1000 },
- term_io__write_term_3(Term, ArgPriority - 1, VarSet0, N0, VarSet, N).
-
-:- pred term_io__write_term_3(term(T), ops__priority, varset(T), int, varset(T),
- 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_3(term__functor(Functor, Args, _), Priority,
+:- pred term_io__write_term_2(Ops, term(T), varset(T), int, varset(T), int,
+ io__state, io__state) <= op_table(Ops).
+:- mode term_io__write_term_2(in, in, in, in, out, out, di, uo) is det.
+
+term_io__write_term_2(Ops, Term, VarSet0, N0, VarSet, N) -->
+ term_io__write_term_3(Ops, Term, ops__max_priority(Ops) + 1,
+ VarSet0, N0, VarSet, N).
+
+:- pred term_io__write_arg_term(Ops, term(T), varset(T), int, varset(T), int,
+ io__state, io__state) <= op_table(Ops).
+:- mode term_io__write_arg_term(in, in, in, in, out, out, di, uo) is det.
+
+term_io__write_arg_term(Ops, Term, VarSet0, N0, VarSet, N) -->
+ term_io__write_term_3(Ops, Term, ops__arg_priority(Ops),
+ VarSet0, N0, VarSet, N).
+
+:- pred term_io__write_term_3(Ops, term(T), ops__priority, varset(T),
+ int, varset(T), int, io__state, io__state) <= op_table(Ops).
+:- mode term_io__write_term_3(in, in, in, in, in, out, out, di, uo) is det.
+
+term_io__write_term_3(Ops, term__variable(Id), _, VarSet0, N0, VarSet, N) -->
+ term_io__write_variable_2(Ops, Id, VarSet0, N0, VarSet, N).
+term_io__write_term_3(Ops, term__functor(Functor, Args, _), Priority,
VarSet0, N0, VarSet, N) -->
- io__get_op_table(OpTable),
(
{ Functor = term__atom("[|]") },
{ Args = [ListHead, ListTail] }
->
io__write_char('['),
- term_io__write_arg_term(ListHead, VarSet0, N0, VarSet1, N1),
- term_io__write_list_tail(ListTail, VarSet1, N1, VarSet, N),
+ term_io__write_arg_term(Ops, ListHead,
+ VarSet0, N0, VarSet1, N1),
+ term_io__write_list_tail(Ops, ListTail,
+ VarSet1, N1, VarSet, N),
io__write_char(']')
;
{ Functor = term__atom("[]") },
@@ -249,15 +284,17 @@
{ Args = [BracedTerm] }
->
io__write_string("{ "),
- term_io__write_term_2(BracedTerm, VarSet0, N0, VarSet, N),
+ term_io__write_term_2(Ops, BracedTerm, VarSet0, N0, VarSet, N),
io__write_string(" }")
;
{ Functor = term__atom("{}") },
{ Args = [BracedHead | BracedTail] }
->
io__write_char('{'),
- term_io__write_arg_term(BracedHead, VarSet0, N0, VarSet1, N1),
- term_io__write_term_args(BracedTail, VarSet1, N1, VarSet, N),
+ term_io__write_arg_term(Ops, BracedHead,
+ VarSet0, N0, VarSet1, N1),
+ term_io__write_term_args(Ops, BracedTail,
+ VarSet1, N1, VarSet, N),
io__write_char('}')
;
% the empty functor '' is used for higher-order syntax:
@@ -266,33 +303,33 @@
{ Functor = term__atom("") },
{ Args = [term__variable(Var), FirstArg | OtherArgs] }
->
- term_io__write_variable_2(Var, VarSet0, N0, VarSet1, N1),
+ term_io__write_variable_2(Ops, Var, VarSet0, N0, VarSet1, N1),
io__write_char('('),
- term_io__write_arg_term(FirstArg, VarSet1, N1, VarSet2, N2),
- term_io__write_term_args(OtherArgs, VarSet2, N2, VarSet, N),
+ term_io__write_arg_term(Ops, FirstArg,
+ VarSet1, N1, VarSet2, N2),
+ term_io__write_term_args(Ops, OtherArgs,
+ VarSet2, N2, VarSet, N),
io__write_char(')')
;
{ Args = [PrefixArg] },
{ Functor = term__atom(OpName) },
- { ops__lookup_prefix_op(OpTable, OpName,
- OpPriority, OpAssoc) }
+ { ops__lookup_prefix_op(Ops, OpName, OpPriority, OpAssoc) }
->
maybe_write_char('(', Priority, OpPriority),
term_io__write_constant(Functor),
io__write_char(' '),
{ adjust_priority(OpPriority, OpAssoc, NewPriority) },
- term_io__write_term_3(PrefixArg, NewPriority,
+ term_io__write_term_3(Ops, PrefixArg, NewPriority,
VarSet0, N0, VarSet, N),
maybe_write_char(')', Priority, OpPriority)
;
{ Args = [PostfixArg] },
{ Functor = term__atom(OpName) },
- { ops__lookup_postfix_op(OpTable, OpName,
- OpPriority, OpAssoc) }
+ { ops__lookup_postfix_op(Ops, OpName, OpPriority, OpAssoc) }
->
maybe_write_char('(', Priority, OpPriority),
{ adjust_priority(OpPriority, OpAssoc, NewPriority) },
- term_io__write_term_3(PostfixArg, NewPriority,
+ term_io__write_term_3(Ops, PostfixArg, NewPriority,
VarSet0, N0, VarSet, N),
io__write_char(' '),
term_io__write_constant(Functor),
@@ -300,12 +337,12 @@
;
{ Args = [Arg1, Arg2] },
{ Functor = term__atom(OpName) },
- { ops__lookup_infix_op(OpTable, OpName,
+ { ops__lookup_infix_op(Ops, OpName,
OpPriority, LeftAssoc, RightAssoc) }
->
maybe_write_char('(', Priority, OpPriority),
{ adjust_priority(OpPriority, LeftAssoc, LeftPriority) },
- term_io__write_term_3(Arg1, LeftPriority,
+ term_io__write_term_3(Ops, Arg1, LeftPriority,
VarSet0, N0, VarSet1, N1),
( { OpName = "," } ->
io__write_string(", ")
@@ -315,33 +352,32 @@
io__write_char(' ')
),
{ adjust_priority(OpPriority, RightAssoc, RightPriority) },
- term_io__write_term_3(Arg2, RightPriority,
+ term_io__write_term_3(Ops, 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(Ops, OpName,
OpPriority, FirstAssoc, SecondAssoc) }
->
maybe_write_char('(', Priority, OpPriority),
term_io__write_constant(Functor),
io__write_char(' '),
{ adjust_priority(OpPriority, FirstAssoc, FirstPriority) },
- term_io__write_term_3(Arg1, FirstPriority,
+ term_io__write_term_3(Ops, Arg1, FirstPriority,
VarSet0, N0, VarSet1, N1),
io__write_char(' '),
{ adjust_priority(OpPriority, SecondAssoc, SecondPriority) },
- term_io__write_term_3(Arg2, SecondPriority,
+ term_io__write_term_3(Ops, Arg2, SecondPriority,
VarSet1, N1, VarSet, N),
maybe_write_char(')', Priority, OpPriority)
;
(
{ Args = [] },
{ Functor = term__atom(Op) },
- { ops__lookup_op(OpTable, Op) },
- { ops__max_priority(MaxPriority) },
- { Priority =< MaxPriority }
+ { ops__lookup_op(Ops, Op) },
+ { Priority =< ops__max_priority(Ops) }
->
io__write_char('('),
term_io__write_constant(Functor),
@@ -354,8 +390,10 @@
{ Args = [X|Xs] }
->
io__write_char('('),
- term_io__write_arg_term(X, VarSet0, N0, VarSet1, N1),
- term_io__write_term_args(Xs, VarSet1, N1, VarSet, N),
+ term_io__write_arg_term(Ops, X,
+ VarSet0, N0, VarSet1, N1),
+ term_io__write_term_args(Ops, Xs,
+ VarSet1, N1, VarSet, N),
io__write_char(')')
;
{ N = N0,
@@ -380,23 +418,24 @@
adjust_priority(Priority, y, Priority).
adjust_priority(Priority, x, Priority - 1).
-:- pred term_io__write_list_tail(term(T), varset(T), int, varset(T), int,
- io__state, io__state).
-:- mode term_io__write_list_tail(in, in, in, out, out, di, uo) is det.
+:- pred term_io__write_list_tail(Ops, term(T), varset(T), int, varset(T), int,
+ io__state, io__state) <= op_table(Ops).
+:- mode term_io__write_list_tail(in, in, in, in, out, out, di, uo) is det.
-term_io__write_list_tail(Term, VarSet0, N0, VarSet, N) -->
+term_io__write_list_tail(Ops, Term, VarSet0, N0, VarSet, N) -->
(
{ Term = term__variable(Id) },
{ varset__search_var(VarSet0, Id, Val) }
->
- term_io__write_list_tail(Val, VarSet0, N0, VarSet, N)
+ term_io__write_list_tail(Ops, Val, VarSet0, N0, VarSet, N)
;
{ Term = term__functor(term__atom("[|]"),
[ListHead, ListTail], _) }
->
io__write_string(", "),
- term_io__write_arg_term(ListHead, VarSet0, N0, VarSet1, N1),
- term_io__write_list_tail(ListTail, VarSet1, N1, VarSet, N)
+ term_io__write_arg_term(Ops, ListHead,
+ VarSet0, N0, VarSet1, N1),
+ term_io__write_list_tail(Ops, ListTail, VarSet1, N1, VarSet, N)
;
{ Term = term__functor(term__atom("[]"), [], _) }
->
@@ -404,21 +443,21 @@
{ N = N0 }
;
io__write_string(" | "),
- term_io__write_term_2(Term, VarSet0, N0, VarSet, N)
+ term_io__write_term_2(Ops, Term, VarSet0, N0, VarSet, N)
).
%-----------------------------------------------------------------------------%
-:- pred term_io__write_term_args(list(term(T)), varset(T), int, varset(T), int,
- io__state, io__state).
-:- mode term_io__write_term_args(in, in, in, out, out, di, uo) is det.
+:- pred term_io__write_term_args(Ops, list(term(T)), varset(T), int,
+ varset(T), int, io__state, io__state) <= op_table(Ops).
+:- mode term_io__write_term_args(in, in, in, in, out, out, di, uo) is det.
% write the remaining arguments
-term_io__write_term_args([], VarSet, N, VarSet, N) --> [].
-term_io__write_term_args([X|Xs], VarSet0, N0, VarSet, N) -->
+term_io__write_term_args(_, [], VarSet, N, VarSet, N) --> [].
+term_io__write_term_args(Ops, [X|Xs], VarSet0, N0, VarSet, N) -->
io__write_string(", "),
- term_io__write_arg_term(X, VarSet0, N0, VarSet1, N1),
- term_io__write_term_args(Xs, VarSet1, N1, VarSet, N).
+ term_io__write_arg_term(Ops, X, VarSet0, N0, VarSet1, N1),
+ term_io__write_term_args(Ops, Xs, VarSet1, N1, VarSet, N).
%-----------------------------------------------------------------------------%
@@ -698,7 +737,11 @@
%-----------------------------------------------------------------------------%
term_io__write_term_nl(VarSet, Term) -->
- term_io__write_term(VarSet, Term),
+ io__get_op_table(Ops),
+ term_io__write_term_nl_with_op_table(Ops, VarSet, Term).
+
+term_io__write_term_nl_with_op_table(Ops, VarSet, Term) -->
+ term_io__write_term_with_op_table(Ops, VarSet, Term),
io__write_string(".\n").
%-----------------------------------------------------------------------------%
Index: samples/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/Mmakefile,v
retrieving revision 1.5
diff -u -u -r1.5 Mmakefile
--- samples/Mmakefile 5 Dec 1999 12:54:40 -0000 1.5
+++ samples/Mmakefile 5 Nov 2001 13:14:48 -0000
@@ -8,7 +8,7 @@
# To build these programs, first install the Mercury compiler,
# type `mmake depend', and then type `mmake'.
-PROGS= hello cat calculator sort eliza ultra_sub e \
+PROGS= hello cat calculator calculator2 sort eliza ultra_sub e \
interpreter expand_terms
DEPENDS=$(PROGS:%=%.depend)
Index: samples/README
===================================================================
RCS file: /home/mercury1/repository/mercury/samples/README,v
retrieving revision 1.6
diff -u -u -r1.6 README
--- samples/README 20 Oct 1999 03:14:25 -0000 1.6
+++ samples/README 5 Nov 2001 13:48:55 -0000
@@ -18,6 +18,11 @@
with a parser written using the Definite Clause
Grammar notation.
+calculator2.m A simple four-function arithmetic calculator,
+ which uses the parser module in the standard
+ library with a user-defined operator precendence
+ table.
+
committed_choice.m An example illustrating committed-choice
nondeterminism in Mercury.
Index: samples/calculator2.m
===================================================================
RCS file: samples/calculator2.m
diff -N samples/calculator2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ samples/calculator2.m 5 Nov 2001 13:14:23 -0000
@@ -0,0 +1,182 @@
+% Another calculator - parses and evaluates integer expression terms.
+% This module demonstrates the use of user-defined operator precedence
+% tables with parser__read_term.
+%
+% Note that unlike calculator.m, the expressions must be terminated with a `.'.
+% This version also allows variable assignments of the form `X = Exp.'.
+%
+% Author: stayl.
+
+% This source file is hereby placed in the public domain. -stayl.
+
+:- module calculator2.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+:- import_module exception, int, list, map, ops, parser, require.
+:- import_module std_util, string, term, term_io, varset.
+
+:- type calc_info == map(string, int).
+
+main -->
+ main_2(map__init).
+
+:- pred main_2(calc_info::in, io::di, io::uo) is cc_multi.
+
+main_2(CalcInfo0) -->
+ io__write_string("calculator> "),
+ io__flush_output,
+ parser__read_term_with_op_table(calculator_op_table, Res),
+ ( { Res = error(Msg, _Line) },
+ io__write_string(Msg),
+ io__nl,
+ main
+ ; { Res = eof },
+ io__write_string("EOF\n")
+ ; { Res = term(VarSet, Term) },
+ {
+ Term = term__functor(term__atom("="),
+ [term__variable(Var), ExprTerm0], _)
+ ->
+ ExprTerm = ExprTerm0,
+ varset__lookup_name(VarSet, Var, VarName),
+ SetVar = yes(VarName)
+ ;
+ ExprTerm = Term,
+ SetVar = no
+ },
+
+ { try(
+ (pred(Num0::out) is det :-
+ Num0 = eval_expr(CalcInfo0, VarSet, ExprTerm)
+ ), EvalResult) },
+ (
+ { EvalResult = succeeded(Num) },
+ io__write_int(Num),
+ io__nl,
+ { SetVar = yes(VarToSet) ->
+ map__set(CalcInfo0, VarToSet, Num, CalcInfo)
+ ;
+ CalcInfo = CalcInfo0
+ }
+ ;
+ { EvalResult = exception(Exception) },
+ { CalcInfo = CalcInfo0 },
+ ( { univ_to_type(Exception, EvalError) } ->
+ report_eval_error(EvalError)
+ ;
+ { rethrow(EvalResult) }
+ )
+ ),
+
+ % recursively call ourself for the next term(s)
+ main_2(CalcInfo)
+ ).
+
+:- pred report_eval_error(eval_error::in, io::di, io::uo) is det.
+
+report_eval_error(unknown_operator(Name, Arity)) -->
+ io__write_string("unknown operator `"),
+ io__write_string(Name),
+ io__write_string("/"),
+ io__write_int(Arity),
+ io__write_string("'.\n").
+report_eval_error(unknown_variable(Name)) -->
+ io__write_string("unknown variable `"),
+ io__write_string(Name),
+ io__write_string("'.\n").
+report_eval_error(unexpected_const(Const)) -->
+ io__write_string("unexpected "),
+ ( { Const = term__integer(_) },
+ { error("report_eval_error") }
+ ; { Const = term__float(Float) },
+ io__write_string(" float `"),
+ io__write_float(Float),
+ io__write_string("'")
+ ; { Const = term__string(String) },
+ io__write_string(" string """),
+ io__write_string(String),
+ io__write_string("""")
+ ; { Const = term__atom(_) },
+ { error("report_eval_error") }
+ ),
+ io__nl.
+
+:- func eval_expr(calc_info, varset, term) = int.
+
+eval_expr(CalcInfo, VarSet, term__variable(Var)) = Res :-
+ varset__lookup_name(VarSet, Var, VarName),
+ ( map__search(CalcInfo, VarName, Res0) ->
+ Res = Res0
+ ;
+ throw(unknown_variable(VarName))
+ ).
+eval_expr(CalcInfo, VarSet, term__functor(term__atom(Op), Args, _)) = Res :-
+ (
+ ( Args = [Arg1],
+ Res0 = eval_unop(Op, eval_expr(CalcInfo, VarSet, Arg1))
+ ; Args = [Arg1, Arg2],
+ Res0 = eval_binop(Op,
+ eval_expr(CalcInfo, VarSet, Arg1),
+ eval_expr(CalcInfo, VarSet, Arg2))
+ )
+ ->
+ Res = Res0
+ ;
+ throw(unknown_operator(Op, list__length(Args)))
+ ).
+eval_expr(_, _, term__functor(term__integer(Int), _, _)) = Int.
+eval_expr(_, _, term__functor(term__float(Float), _, Context)) =
+ throw(unexpected_const(term__float(Float)) - Context).
+eval_expr(_, _, term__functor(term__string(String), _, Context)) =
+ throw(unexpected_const(term__string(String)) - Context).
+
+:- func eval_unop(string, int) = int is semidet.
+
+eval_unop("-", Num) = -Num.
+eval_unop("+", Num) = Num.
+
+:- func eval_binop(string, int, int) = int is semidet.
+
+eval_binop("-", Num1, Num2) = Num1 - Num2.
+eval_binop("+", Num1, Num2) = Num1 + Num2.
+eval_binop("*", Num1, Num2) = Num1 * Num2.
+eval_binop("//", Num1, Num2) = Num1 // Num2.
+
+:- type eval_error
+ ---> unknown_operator(
+ string, % name
+ int % arity
+ )
+ ; unknown_variable(string)
+ ; unexpected_const(term__const)
+ .
+
+:- type calculator_op_table ---> calculator_op_table.
+
+:- instance ops__op_table(calculator_op_table) where [
+ ops__lookup_infix_op(_, "//", 400, y, x),
+ ops__lookup_infix_op(_, "*", 400, y, x),
+ ops__lookup_infix_op(_, "+", 500, y, x),
+ ops__lookup_infix_op(_, "-", 500, y, x),
+ ops__lookup_infix_op(_, "=", 700, x, x),
+
+ ops__lookup_prefix_op(_, "-", 200, x),
+ ops__lookup_prefix_op(_, "+", 500, x),
+
+ ops__lookup_postfix_op(_, _, _, _) :- fail,
+ ops__lookup_binary_prefix_op(_, _, _, _, _) :- fail,
+
+ ops__lookup_op(Table, Op) :- ops__lookup_infix_op(Table, Op, _, _, _),
+ ops__lookup_op(Table, Op) :- ops__lookup_prefix_op(Table, Op, _, _),
+ ops__lookup_op(Table, Op) :-
+ ops__lookup_binary_prefix_op(Table, Op, _, _, _),
+ ops__lookup_op(Table, Op) :- ops__lookup_postfix_op(Table, Op, _, _),
+
+ ops__max_priority(_) = 700,
+ ops__arg_priority(Table) = ops__max_priority(Table) + 1
+].
+
Index: tests/hard_coded/term_io_test.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/term_io_test.exp,v
retrieving revision 1.1
diff -u -u -r1.1 term_io_test.exp
--- tests/hard_coded/term_io_test.exp 13 Nov 1998 05:33:02 -0000 1.1
+++ tests/hard_coded/term_io_test.exp 4 Nov 2001 14:25:09 -0000
@@ -1 +1 @@
-foo((pred((A :: in), (B :: out)) is det :- p(A, C), q(C, B)), D, E).
+foo(pred(A :: in, B :: out) is det :- p(A, C), q(C, B), D, E).
Index: tests/invalid/func_errors.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/func_errors.err_exp,v
retrieving revision 1.3
diff -u -u -r1.3 func_errors.err_exp
--- tests/invalid/func_errors.err_exp 16 Feb 2000 07:28:03 -0000 1.3
+++ tests/invalid/func_errors.err_exp 4 Nov 2001 14:26:55 -0000
@@ -1,5 +1,5 @@
-func_errors.m:010: Error: some but not all arguments have modes: bar((int :: in), int).
-func_errors.m:011: Error: function arguments have modes, but function result doesn't: baz((int :: in), (int :: in)).
+func_errors.m:010: Error: some but not all arguments have modes: bar(int :: in, int).
+func_errors.m:011: Error: function arguments have modes, but function result doesn't: baz(int :: in, int :: in).
func_errors.m:012: Error: function result has mode, but function arguments don't: quux(int, int).
-func_errors.m:018: Error: some but not all arguments have modes: q((int :: in), int).
+func_errors.m:018: Error: some but not all arguments have modes: q(int :: in, int).
For more information, try recompiling with `-E'.
Index: tests/invalid/inst_list_dup.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/inst_list_dup.err_exp,v
retrieving revision 1.2
diff -u -u -r1.2 inst_list_dup.err_exp
--- tests/invalid/inst_list_dup.err_exp 27 Dec 1999 11:07:33 -0000 1.2
+++ tests/invalid/inst_list_dup.err_exp 4 Nov 2001 14:27:56 -0000
@@ -1,3 +1,3 @@
-inst_list_dup.m:003: Error: syntax error in inst body: bound((ground - unique ; ground - ground)).
+inst_list_dup.m:003: Error: syntax error in inst body: bound(ground - unique ; ground - ground).
inst_list_dup.m: 1: Warning: interface for module `inst_list_dup' does not export anything.
For more information, try recompiling with `-E'.
Index: tests/invalid/predmode.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/predmode.err_exp,v
retrieving revision 1.4
diff -u -u -r1.4 predmode.err_exp
--- tests/invalid/predmode.err_exp 15 Nov 1998 06:56:56 -0000 1.4
+++ tests/invalid/predmode.err_exp 4 Nov 2001 14:28:31 -0000
@@ -1,3 +1,3 @@
-predmode.m:005: Error: some but not all arguments have modes: p((int :: in), int).
+predmode.m:005: Error: some but not all arguments have modes: p(int :: in, int).
predmode.m: 1: Warning: interface for module `predmode' does not export anything.
For more information, try recompiling with `-E'.
Index: tests/invalid/some.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/some.err_exp,v
retrieving revision 1.2
diff -u -u -r1.2 some.err_exp
--- tests/invalid/some.err_exp 15 Nov 1998 06:56:57 -0000 1.2
+++ tests/invalid/some.err_exp 4 Nov 2001 14:28:47 -0000
@@ -1,4 +1,4 @@
-some.m:006: Error: unrecognized declaration: some junk pred p2((int :: in)) is semidet.
+some.m:006: Error: unrecognized declaration: some junk pred p2(int :: in) is semidet.
some.m:012: In clause for predicate `some:p1/1':
some.m:012: in argument 1 of call to predicate `some/2':
some.m:012: error: undefined symbol `junk/0'.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list