[m-rev.] diff: bitrot fixes and cleanups for extras/trailed_update
Julien Fischer
juliensf at csse.unimelb.edu.au
Fri Dec 17 02:03:24 AEDT 2010
Branches: main
Fix bitrot in extras/trailed_update.
extras/trailed_updated/var.m:
Don't specify an initialisation predicated for the solver type var/1.
extras/trailed_updated/samples/interpreter.m:
Conform with the change that added an extra argument to the variable/2
constructor of the standard library type term/1.
extras/trailed_update/tests/var_test.m:
Use up-to-date syntax for modes.
extras/trailed_update/Mmakefile:
extras/trailed_update/samples/Mmakefile:
extras/trailed_update/tests/var_test.m:
Use trail segments since that's what you get in an installation by
default.
extras/trailed_update/*.m:
Update syntax and formatting to conform more closely to our
current coding standards.
Add require_feature_set pragmas for trailing.
Julien.
Index: Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/trailed_update/Mmakefile,v
retrieving revision 1.13
diff -u -r1.13 Mmakefile
--- Mmakefile 30 Jul 2004 07:03:46 -0000 1.13
+++ Mmakefile 16 Dec 2010 14:59:49 -0000
@@ -4,7 +4,7 @@
# Public License - see the file COPYING.LIB in the Mercury distribution.
#-----------------------------------------------------------------------------#
-GRADEFLAGS += --use-trail
+GRADEFLAGS += --use-trail --trail-segments
# enable C debugging
MGNUCFLAGS = -g
Index: tr_array.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/trailed_update/tr_array.m,v
retrieving revision 1.13
diff -u -r1.13 tr_array.m
--- tr_array.m 7 Jun 2007 03:28:06 -0000 1.13
+++ tr_array.m 16 Dec 2010 14:59:49 -0000
@@ -178,8 +178,11 @@
%-----------------------------------------------------------------------------%
:- implementation.
+
:- import_module int.
+:- pragma require_feature_set([trailing]).
+
/****
lower bounds other than zero are not supported
% tr_array.resize takes an array and new lower and upper bounds.
@@ -402,7 +405,7 @@
tr_array.shrink(Array0::array_mui, Size::in, Array::array_uo),
[promise_pure, will_not_call_mercury],
"
- MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
+ MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array.array/1"");
ML_tr_shrink_array((MR_ArrayType *) Array,
(const MR_ArrayType *) Array0, Size);
").
Index: tr_store.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/trailed_update/tr_store.m,v
retrieving revision 1.16
diff -u -r1.16 tr_store.m
--- tr_store.m 31 Aug 2006 11:09:51 -0000 1.16
+++ tr_store.m 16 Dec 2010 14:59:49 -0000
@@ -165,8 +165,13 @@
%-----------------------------------------------------------------------------%
:- implementation.
+
:- import_module deconstruct.
+:- pragma require_feature_set([trailing]).
+
+%-----------------------------------------------------------------------------%
+
:- pragma foreign_proc("C",
new_mutvar(Val::in, Mutvar::out, S0::mdi, S::muo),
[promise_pure, will_not_call_mercury],
Index: trailed_update.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/trailed_update/trailed_update.m,v
retrieving revision 1.3
diff -u -r1.3 trailed_update.m
--- trailed_update.m 26 Sep 1997 15:28:06 -0000 1.3
+++ trailed_update.m 16 Dec 2010 14:59:49 -0000
@@ -1,2 +1,25 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
+
:- module trailed_update.
-:- import_module tr_array, tr_store, var, unsafe.
+:- interface.
+
+%-----------------------------------------------------------------------------%
+
+:- import_module tr_array.
+:- import_module tr_store.
+:- import_module unsafe.
+:- import_module var.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma require_feature_set([trailing]).
+
+%-----------------------------------------------------------------------------%
+:- end_module trailed_update.
+%-----------------------------------------------------------------------------%
+
Index: var.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/trailed_update/var.m,v
retrieving revision 1.29
diff -u -r1.29 var.m
--- var.m 31 Jul 2007 07:58:43 -0000 1.29
+++ var.m 16 Dec 2010 14:59:49 -0000
@@ -92,8 +92,8 @@
% future releases.
%
:- pred freeze(var(T1), pred(T1, T2), var(T2)).
-:- mode freeze(in, pred(in, out) is det, out) is semidet. % really det
-:- mode freeze(in, pred(in, out) is semidet, out) is semidet.
+:- mode freeze(in, pred(in, out) is det, out) is semidet. % really det
+:- mode freeze(in, pred(in, out) is semidet, out) is semidet.
:- mode freeze(oa, pred(in, out) is det, oa) is semidet.
:- mode freeze(oa, pred(in, out) is semidet, oa) is semidet.
@@ -175,7 +175,6 @@
%
:- solver type var(T)
where representation is var_rep(T),
- initialisation is init,
ground is ground,
any is any,
equality is (==).
Index: samples/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/trailed_update/samples/Mmakefile,v
retrieving revision 1.18
diff -u -r1.18 Mmakefile
--- samples/Mmakefile 31 Jul 2007 07:58:43 -0000 1.18
+++ samples/Mmakefile 16 Dec 2010 14:59:49 -0000
@@ -7,7 +7,7 @@
MAIN_TARGET = all
# We need to use a grade with trailing
-GRADEFLAGS += --use-trail
+GRADEFLAGS += --use-trail --trail-segments
MCFLAGS = --infer-all
Index: samples/interpreter.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/trailed_update/samples/interpreter.m,v
retrieving revision 1.9
diff -u -r1.9 interpreter.m
--- samples/interpreter.m 21 Apr 2006 04:12:21 -0000 1.9
+++ samples/interpreter.m 16 Dec 2010 14:59:49 -0000
@@ -1,80 +1,98 @@
%-----------------------------------------------------------------------------%
-
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
+%
% File: interpreter.m.
% Main author: fjh.
-
+%
% This is an interpreter for definite logic programs
% (i.e. pure Prolog with no negation or if-then-else.)
%
% This is just intended as a demonstration of the use of the
% library module tr_store.m.
-
+%
% There are many extensions/improvements that could be made;
% they're left as an exercise for the reader.
-
+%
% This source file is hereby placed in the public domain. -fjh (the author).
-
+%
%-----------------------------------------------------------------------------%
:- module interpreter.
:- interface.
:- import_module io.
-:- pred main(io__state, io__state).
-:- mode main(di, uo) is cc_multi.
+:- pred main(io::di, io::uo) is cc_multi.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module list, string, term, varset, term_io, require, pair, solutions.
-:- import_module store, tr_store, map, multi_map, assoc_list.
+
+:- import_module tr_store.
:- import_module unsafe.
-main -->
- io__write_string("Pure Prolog Interpreter.\n\n"),
- io__command_line_arguments(Args),
- ( { Args = [] } ->
- io__stderr_stream(StdErr),
- io__write_string(StdErr, "Usage: interpreter filename ...\n"),
- io__set_exit_status(1)
- ;
- { database_init(Database0) },
- consult_list(Args, Database0, Database),
- main_loop(Database)
- ).
-
-:- pred main_loop(database, io__state, io__state).
-:- mode main_loop(in, di, uo) is cc_multi.
-
-main_loop(Database) -->
- io__write_string("?- "),
- term_io__read_term(ReadTerm),
- main_loop_2(ReadTerm, Database).
-
-:- pred main_loop_2(read_term, database, io__state, io__state).
-:- mode main_loop_2(in, in, di, uo) is cc_multi.
-
-main_loop_2(eof, _Database) --> [].
-main_loop_2(error(ErrorMessage, LineNumber), Database) -->
- io__write_string("Error reading term at line "),
- io__write_int(LineNumber),
- io__write_string(" of standard input: "),
- io__write_string(ErrorMessage),
- io__write_string("\n"),
- main_loop(Database).
-main_loop_2(term(VarSet, Goal), Database) -->
+:- import_module assoc_list.
+:- import_module map.
+:- import_module multi_map.
+:- import_module list.
+:- import_module pair.
+:- import_module require.
+:- import_module solutions.
+:- import_module store.
+:- import_module string.
+:- import_module svmap.
+:- import_module term.
+:- import_module term_io.
+:- import_module varset.
+
+:- pragma require_feature_set([trailing]).
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ io.write_string("Pure Prolog Interpreter.\n\n", !IO),
+ io.command_line_arguments(Args, !IO),
+ (
+ Args = [],
+ io.stderr_stream(StdErr, !IO),
+ io.write_string(StdErr, "Usage: interpreter filename ...\n",
+ !IO),
+ io.set_exit_status(1, !IO)
+ ;
+ Args = [_ | _],
+ database_init(Database0),
+ consult_list(Args, Database0, Database, !IO),
+ main_loop(Database, !IO)
+ ).
+
+:- pred main_loop(database::in, io::di, io::uo) is cc_multi.
+
+main_loop(Database, !IO) :-
+ io.write_string("?- ", !IO),
+ term_io.read_term(ReadTerm, !IO),
+ main_loop_2(ReadTerm, Database, !IO).
+
+:- pred main_loop_2(read_term::in, database::in,
+ io::di, io::uo) is cc_multi.
+
+main_loop_2(eof, _Database, !IO).
+main_loop_2(error(ErrorMessage, LineNumber), Database, !IO) :-
+ io.format("Error reading term at line %d of standard input: %s\n",
+ [i(LineNumber), s(ErrorMessage)], !IO),
+ main_loop(Database, !IO).
+main_loop_2(term(VarSet, Goal), Database, !IO) :-
%%% It would be a good idea to add some special commands
%%% with side-effects (such as `consult' and `listing');
%%% these could be identified and processed here.
- { store__new(Store0) },
- { map__init(VarMap0) },
- { term_to_my_term(Goal, MyGoal, VarMap0, VarMap, Store0, Store1) },
- print_solutions(VarSet, VarMap, MyGoal, Store1, Database),
- main_loop(Database).
-
-:- pred print_solutions(varset, map(var, my_var(S)), my_term(S),
- store(S), database, io__state, io__state).
-:- mode print_solutions(in, in, in, mdi, in, di, uo) is cc_multi.
+ store.new(Store0),
+ map.init(VarMap0),
+ term_to_my_term(Goal, MyGoal, VarMap0, VarMap, Store0, Store1),
+ print_solutions(VarSet, VarMap, MyGoal, Store1, Database, !IO),
+ main_loop(Database, !IO).
+
+:- pred print_solutions(varset::in, map(var, my_var(S))::in, my_term(S)::in,
+ store(S)::mdi, database::in, io::di, io::uo) is cc_multi.
% The call to unsafe_promise_unique here is needed because without it,
% the following code gets a (spurious) unique mode error,
@@ -88,256 +106,240 @@
% so that we can prompt the user after each solution to see if they
% want to see the next solution.
%
-print_solutions(VarSet, VarMap, MyGoal, Store0, Database) -->
- unsorted_aggregate(
- (pred(Store::muo) is nondet :-
- solve(Database, MyGoal, unsafe_promise_unique(Store0),
- Store)),
- write_solution(VarSet, VarMap, MyGoal)),
- io__write_string("No (more) solutions.\n").
-
-:- pred write_solution(varset, map(var, my_var(S)), my_term(S), store(S),
- io__state, io__state).
-:- mode write_solution(in, in, in, mdi, di, uo) is det.
-
-write_solution(VarSet0, VarToMyVarMap, MyGoal, Store0) -->
- { map__keys(VarToMyVarMap, Vars) },
- { map__values(VarToMyVarMap, MyVars) },
- { assoc_list__from_corresponding_lists(MyVars, Vars, VarMap0) },
- { my_term_to_term(MyGoal, Goal, VarSet0, VarSet, VarMap0, _VarMap,
- Store0, _Store) },
- term_io__write_term_nl(VarSet, Goal).
-
-%-----------------------------------------------------------------------------%
-
-:- pred consult_list(list(string), database, database, io__state, io__state).
-:- mode consult_list(in, in, out, di, uo) is det.
-
-consult_list([], Database, Database) --> [].
-consult_list([File | Files], Database0, Database) -->
- consult(File, Database0, Database1),
- consult_list(Files, Database1, Database).
-
-:- pred consult(string, database, database, io__state, io__state).
-:- mode consult(in, in, out, di, uo) is det.
-
-consult(File, Database0, Database) -->
- io__write_string("Consulting file `"),
- io__write_string(File),
- io__write_string("'...\n"),
- io__see(File, Result),
- ( { Result = ok } ->
- consult_until_eof(Database0, Database),
- io__seen
- ;
- io__write_string("Error opening file `"),
- io__write_string(File),
- io__write_string("' for input.\n"),
- { Database = Database0 }
- ).
-
-:- pred consult_until_eof(database, database, io__state, io__state).
-:- mode consult_until_eof(in, out, di, uo) is det.
-
-consult_until_eof(Database0, Database) -->
- term_io__read_term(ReadTerm),
- consult_until_eof_2(ReadTerm, Database0, Database).
-
-:- pred consult_until_eof_2(read_term, database, database,
- io__state, io__state).
-:- mode consult_until_eof_2(in, in, out, di, uo) is det.
-
-consult_until_eof_2(eof, Database, Database) --> [].
-
-consult_until_eof_2(error(ErrorMessage, LineNumber), Database0, Database) -->
- io__write_string("Error reading term at line "),
- io__write_int(LineNumber),
- io__write_string(" of standard input: "),
- io__write_string(ErrorMessage),
- io__write_string("\n"),
- consult_until_eof(Database0, Database).
-
-consult_until_eof_2(term(VarSet, Term), Database0, Database) -->
- { database_assert_clause(Database0, VarSet, Term, Database1) },
- consult_until_eof(Database1, Database).
+print_solutions(VarSet, VarMap, MyGoal, Store0, Database, !IO) :-
+ SolvePred = (pred(Store::muo) is nondet :-
+ solve(Database, MyGoal, unsafe_promise_unique(Store0), Store)
+ ),
+ unsorted_aggregate(SolvePred, write_solution(VarSet, VarMap, MyGoal),
+ !IO),
+ io.write_string("No (more) solutions.\n", !IO).
+
+:- pred write_solution(varset::in, map(var, my_var(S))::in,
+ my_term(S)::in, store(S)::mdi, io::di, io::uo) is det.
+
+write_solution(VarSet0, VarToMyVarMap, MyGoal, Store0, !IO) :-
+ map.keys(VarToMyVarMap, Vars),
+ map.values(VarToMyVarMap, MyVars),
+ assoc_list.from_corresponding_lists(MyVars, Vars, VarMap0),
+ my_term_to_term(MyGoal, Goal, VarSet0, VarSet, VarMap0, _VarMap,
+ Store0, _Store),
+ term_io.write_term_nl(VarSet, Goal, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred consult_list(list(string)::in, database::in, database::out,
+ io::di, io::uo) is det.
+
+consult_list([], !Database, !IO).
+consult_list([File | Files], !Database, !IO) :-
+ consult(File, !Database, !IO),
+ consult_list(Files, !Database, !IO).
+
+:- pred consult(string::in, database::in, database::out,
+ io::di, io::uo) is det.
+
+consult(File, !Database, !IO) :-
+ io.format("Consulting file `%s'...\n", [s(File)], !IO),
+ io.see(File, Result, !IO),
+ (
+ Result = ok,
+ consult_until_eof(!Database, !IO),
+ io.seen(!IO)
+ ;
+ Result = error(_),
+ io.format("Error opening file `%s' for input.\n", [s(File)], !IO)
+ ).
+
+:- pred consult_until_eof(database::in, database::out, io::di, io::uo) is det.
+
+consult_until_eof(!Database, !IO) :-
+ term_io.read_term(ReadTerm, !IO),
+ consult_until_eof_2(ReadTerm, !Database, !IO).
+
+:- pred consult_until_eof_2(read_term::in, database::in, database::out,
+ io::di, io::uo) is det.
+
+consult_until_eof_2(eof, !Database, !IO).
+
+consult_until_eof_2(error(ErrorMessage, LineNumber), !Database, !IO) :-
+ io.format("Error reading term at line %d of standard input: %s\n",
+ [i(LineNumber), s(ErrorMessage)], !IO),
+ consult_until_eof(!Database, !IO).
+
+consult_until_eof_2(term(VarSet, Term), !Database, !IO) :-
+ database_assert_clause(VarSet, Term, !Database),
+ consult_until_eof(!Database, !IO).
%-----------------------------------------------------------------------------%
% Here's how we represent terms.
% We don't use the Mercury standard library type `term', because
% that isn't efficient enough; we want variables to be represented
-% as mutable variables using the store__mutvar type, so that we
+% as mutable variables using the store.mutvar type, so that we
% can implement variable binding as backtrackable destructive update,
% using the tr_store module.
-:- type my_var(S)
- == generic_mutvar(my_term(S), S).
+:- type my_var(S) == generic_mutvar(my_term(S), S).
:- type my_term(S)
---> var(my_var(S))
- ; free
- ; functor(const, list(my_term(S))).
+ ; free
+ ; functor(const, list(my_term(S))).
%-----------------------------------------------------------------------------%
% Convert from the standard Mercury `term' representation to
% our `my_term' representation.
-:- pred term_to_my_term(term, my_term(S), store(S), store(S)).
-:- mode term_to_my_term(in, out, mdi, muo) is det.
+:- pred term_to_my_term(term::in, my_term(S)::out,
+ store(S)::mdi, store(S)::muo) is det.
-term_to_my_term(Term, MyTerm) -->
- { map__init(VarMap0) },
- term_to_my_term(Term, MyTerm, VarMap0, _VarMap).
-
-:- pred term_to_my_term_list(list(term), list(my_term(S)), store(S), store(S)).
-:- mode term_to_my_term_list(in, out, mdi, muo) is det.
-
-term_to_my_term_list(Terms, MyTerm) -->
- { map__init(VarMap0) },
- term_to_my_term_list(Terms, MyTerm, VarMap0, _VarMap).
-
-:- pred term_to_my_term(term, my_term(S),
- map(var, my_var(S)), map(var, my_var(S)),
- store(S), store(S)).
-:- mode term_to_my_term(in, out, in, out, mdi, muo) is det.
-
-term_to_my_term(variable(Var), var(Ref), VarMap0, VarMap) -->
- ( { map__search(VarMap0, Var, Ref1) } ->
- { Ref = Ref1 },
- { VarMap = VarMap0 }
+term_to_my_term(Term, MyTerm, !S) :-
+ map.init(VarMap0),
+ term_to_my_term(Term, MyTerm, VarMap0, _VarMap, !S).
+
+:- pred term_to_my_term_list(list(term)::in, list(my_term(S))::out,
+ store(S)::mdi, store(S)::muo) is det.
+
+term_to_my_term_list(Terms, MyTerm, !S) :-
+ map.init(VarMap0),
+ term_to_my_term_list(Terms, MyTerm, VarMap0, _VarMap, !S).
+
+:- pred term_to_my_term(term::in, my_term(S)::out,
+ map(var, my_var(S))::in, map(var, my_var(S))::out,
+ store(S)::mdi, store(S)::muo) is det.
+
+term_to_my_term(variable(Var, _), var(Ref), !VarMap, !S) :-
+ ( map.search(!.VarMap, Var, Ref0) ->
+ Ref = Ref0
;
- tr_store__new_mutvar(free, Ref),
- { map__det_insert(VarMap0, Var, Ref, VarMap) }
+ tr_store.new_mutvar(free, Ref, !S),
+ svmap.det_insert(Var, Ref, !VarMap)
).
term_to_my_term(functor(Functor, Args0, _Context), functor(Functor, Args),
- VarMap0, VarMap) -->
- term_to_my_term_list(Args0, Args, VarMap0, VarMap).
+ !VarMap, !S) :-
+ term_to_my_term_list(Args0, Args, !VarMap, !S).
-:- pred term_to_my_term_list(list(term), list(my_term(S)),
- map(var, my_var(S)), map(var, my_var(S)), store(S), store(S)).
-:- mode term_to_my_term_list(in, out, in, out, mdi, muo) is det.
-
-term_to_my_term_list([], [], VarMap, VarMap) --> [].
-term_to_my_term_list([Term0|Terms0], [Term|Terms], VarMap0, VarMap) -->
- term_to_my_term(Term0, Term, VarMap0, VarMap1),
- term_to_my_term_list(Terms0, Terms, VarMap1, VarMap).
+:- pred term_to_my_term_list(list(term)::in, list(my_term(S))::out,
+ map(var, my_var(S))::in, map(var, my_var(S))::out,
+ store(S)::mdi, store(S)::muo) is det.
+
+term_to_my_term_list([], [], !VarMap, !S).
+term_to_my_term_list([Term0 | Terms0], [Term | Terms], !VarMap, !S) :-
+ term_to_my_term(Term0, Term, !VarMap, !S),
+ term_to_my_term_list(Terms0, Terms, !VarMap, !S).
%-----------------------------------------------------------------------------%
% Convert from our `my_term' representation to
% the standard Mercury `term' representation.
-:- pred my_term_to_term(my_term(S), term, store(S), store(S)).
-:- mode my_term_to_term(in, out, mdi, muo) is det.
+:- pred my_term_to_term(my_term(S)::in, term::out,
+ store(S)::mdi, store(S)::muo) is det.
-my_term_to_term(MyTerm, Term) -->
- { varset__init(VarSet0) },
- { VarMap0 = [] },
- my_term_to_term(MyTerm, Term, VarSet0, _VarSet, VarMap0, _VarMap).
-
-:- pred my_term_to_term_list(list(my_term(S)), list(term), store(S), store(S)).
-:- mode my_term_to_term_list(in, out, mdi, muo) is det.
-
-my_term_to_term_list(MyTerms, Terms) -->
- { varset__init(VarSet0) },
- { VarMap0 = [] },
- my_term_to_term_list(MyTerms, Terms,
- VarSet0, _VarSet, VarMap0, _VarMap).
+my_term_to_term(MyTerm, Term, !S) :-
+ varset.init(VarSet0),
+ VarMap0 = [],
+ my_term_to_term(MyTerm, Term, VarSet0, _VarSet, VarMap0, _VarMap, !S).
+
+:- pred my_term_to_term_list(list(my_term(S))::in, list(term)::out,
+ store(S)::mdi, store(S)::muo) is det.
+
+my_term_to_term_list(MyTerms, Terms, !S) :-
+ varset.init(VarSet0),
+ VarMap0 = [],
+ my_term_to_term_list(MyTerms, Terms, VarSet0, _VarSet,
+ VarMap0, _VarMap, !S).
-% note that we need to use an assoc_list here rather than a map,
+% Note that we need to use an assoc_list here rather than a map,
% because store mutvars can only be tested for equality, not compared
% (this in turn is because in implementations which use copying GC,
% the relative addresses of different mutvars might change after
% a garbage collection).
-:- pred my_term_to_term(my_term(S), term, varset, varset,
- assoc_list(my_var(S), var), assoc_list(my_var(S), var),
- store(S), store(S)).
-:- mode my_term_to_term(in, out, in, out, in, out, mdi, muo) is det.
+:- pred my_term_to_term(my_term(S)::in, term::out, varset::in, varset::out,
+ assoc_list(my_var(S), var)::in, assoc_list(my_var(S), var)::out,
+ store(S)::mdi, store(S)::muo) is det.
-my_term_to_term(var(MyVar), variable(Var), VarSet0, VarSet, VarMap0, VarMap)
- -->
+my_term_to_term(var(MyVar), variable(Var, Context), !VarSet, !VarMap, !S) :-
+ context_init(Context),
%
- % check whether MyVar is in the VarMap;
+ % Check whether MyVar is in the VarMap;
% if so, use its corresponding Var,
- % otherwise, create a fresh Var and insert it into the VarMap
+ % otherwise, create a fresh Var and insert it into the VarMap.
%
- ( { assoc_list__search(VarMap0, MyVar, Var1) } ->
- { Var = Var1 },
- { VarSet1 = VarSet0 },
- { VarMap1 = VarMap0 }
+ ( assoc_list.search(!.VarMap, MyVar, Var0) ->
+ Var = Var0
;
- { varset__new_var(VarSet0, Var, VarSet1) },
- { VarMap1 = [MyVar - Var | VarMap0] }
+ varset.new_var(!.VarSet, Var, !:VarSet),
+ !:VarMap = [MyVar - Var | !.VarMap]
),
%
- % check whether MyVar is bound;
- % if so, insert its binding into the VarSet
+ % Check whether MyVar is bound;
+ % if so, insert its binding into the VarSet.
%
- tr_store__get_mutvar(MyVar, MyValue),
- ( { MyValue \= free } ->
- my_term_to_term(MyValue, Value, VarSet1, VarSet2,
- VarMap1, VarMap),
- { varset__bind_var(VarSet2, Var, Value, VarSet) }
- ;
- { VarMap = VarMap1 },
- { VarSet = VarSet1 }
- ).
-my_term_to_term(free, variable(Var), VarSet0, VarSet, VarMap, VarMap) -->
- { varset__new_var(VarSet0, Var, VarSet) },
- { error("my_term_to_term: unexpected free var") }.
+ tr_store.get_mutvar(MyVar, MyValue, !S),
+ ( MyValue \= free ->
+ my_term_to_term(MyValue, Value, !VarSet, !VarMap, !S),
+ varset.bind_var(!.VarSet, Var, Value, !:VarSet)
+ ;
+ true
+ ).
+my_term_to_term(free, variable(Var, Context), !VarSet, !VarMap, !S) :-
+ context_init(Context),
+ varset.new_var(!.VarSet, Var, !:VarSet),
+ error("my_term_to_term: unexpected free var").
my_term_to_term(functor(Functor, Args0), functor(Functor, Args, Context),
- VarSet0, VarSet, VarMap0, VarMap) -->
- { context_init(Context) },
- my_term_to_term_list(Args0, Args, VarSet0, VarSet, VarMap0, VarMap).
-
-:- pred my_term_to_term_list(list(my_term(S)), list(term), varset, varset,
- assoc_list(my_var(S), var), assoc_list(my_var(S), var),
- store(S), store(S)).
-:- mode my_term_to_term_list(in, out, in, out, in, out, mdi, muo) is det.
-
-my_term_to_term_list([], [], VarSet, VarSet, VarMap, VarMap) --> [].
-my_term_to_term_list([Term0|Terms0], [Term|Terms], VarSet0, VarSet,
- VarMap0, VarMap) -->
- my_term_to_term(Term0, Term, VarSet0, VarSet1, VarMap0, VarMap1),
- my_term_to_term_list(Terms0, Terms, VarSet1, VarSet, VarMap1, VarMap).
+ !VarSet, !VarMap, !S) :-
+ context_init(Context),
+ my_term_to_term_list(Args0, Args, !VarSet, !VarMap, !S).
+
+:- pred my_term_to_term_list(list(my_term(S))::in, list(term)::out,
+ varset::in, varset::out,
+ assoc_list(my_var(S), var)::in, assoc_list(my_var(S), var)::out,
+ store(S)::mdi, store(S)::muo) is det.
+
+my_term_to_term_list([], [], !VarSet, !VarMap, !S).
+my_term_to_term_list([Term0 | Terms0], [Term | Terms], !VarSet, !VarMap, !S) :-
+ my_term_to_term(Term0, Term, !VarSet, !VarMap, !S),
+ my_term_to_term_list(Terms0, Terms, !VarSet, !VarMap, !S).
%-----------------------------------------------------------------------------%
-% Solve takes a database of rules and facts, a goal to be solved,
-% and a varset (which includes a supply of fresh vars, a substitution,
-% and names for [some subset of] the variables). It updates
-% the varset, producing a new substitution and perhaps introducing
-% some new vars, and returns the result.
+% Solve takes a database of rules and facts, a goal to be solved, and a varset
+% (which includes a supply of fresh vars, a substitution, and names for [some
+% subset of] the variables). It updates the varset, producing a new
+% substitution and perhaps introducing some new vars, and returns the result.
% Goals are stored just as terms.
-% (It might be more efficient to parse them
-% before storing them in the database. Currently we do
-% this parsing work every time we interpret a clause.)
-
-:- pred solve(database, my_term(S), store(S), store(S)).
-:- mode solve(in, in, mdi, muo) is nondet.
-
-solve(_Database, functor(atom("true"), [])) --> [].
-
-solve(Database, functor(atom(","), [A, B])) -->
- solve(Database, A),
- solve(Database, B).
-
-solve(Database, functor(atom(";"), [A, B])) -->
- solve(Database, A)
- ;
- solve(Database, B).
-
-solve(_Database, functor(atom("="), [A, B])) -->
- unify(A, B).
-
-solve(Database, Goal) -->
- { database_lookup_clause(Database, Goal, _VarSet, Head0, Body0) },
- term_to_my_term_list([Head0, Body0], [Head, Body]),
- unify(Goal, Head),
- solve(Database, Body).
+% (It might be more efficient to parse them before storing them in the
+% database. Currently we do this parsing work every time we interpret a
+% clause.)
+
+:- pred solve(database::in, my_term(S)::in,
+ store(S)::mdi, store(S)::muo) is nondet.
+
+solve(_Database, functor(atom("true"), []), !S).
+
+solve(Database, functor(atom(","), [A, B]), !S) :-
+ solve(Database, A, !S),
+ solve(Database, B, !S).
+
+solve(Database, functor(atom(";"), [A, B]), !S) :-
+ (
+ solve(Database, A, !S)
+ ;
+ solve(Database, B, !S)
+ ).
+
+solve(_Database, functor(atom("="), [A, B]), !S) :-
+ unify(A, B, !S).
+
+solve(Database, Goal, !S) :-
+ database_lookup_clause(Database, Goal, _VarSet, Head0, Body0),
+ term_to_my_term_list([Head0, Body0], [Head, Body], !S),
+ unify(Goal, Head, !S),
+ solve(Database, Body, !S).
/*
solve(Database, var(Var)) -->
@@ -346,86 +348,86 @@
*/
%-----------------------------------------------------------------------------%
-:- pred unify(my_term(S), my_term(S), store(S), store(S)).
-:- mode unify(in, in, mdi, muo) is semidet.
+:- pred unify(my_term(S)::in, my_term(S)::in, store(S)::mdi, store(S)::muo)
+ is semidet.
-unify(var(X), var(Y)) -->
- tr_store__get_mutvar(X, BindingOfX),
- tr_store__get_mutvar(Y, BindingOfY),
+unify(var(X), var(Y), !S) :-
+ tr_store.get_mutvar(X, BindingOfX, !S),
+ tr_store.get_mutvar(Y, BindingOfY, !S),
(
- { BindingOfX \= free }
+ BindingOfX \= free
->
(
- { BindingOfY \= free }
+ BindingOfY \= free
->
- % both X and Y already have bindings - just
- % unify the terms they are bound to
+ % Both X and Y already have bindings - just
+ % unify the terms they are bound to.
unify(BindingOfX, BindingOfY)
;
- % Y is a variable which hasn't been bound yet
- deref(BindingOfX, SubstBindingOfX),
- ( { SubstBindingOfX = var(Y) } ->
- []
+ % Y is a variable which hasn't been bound yet.
+ deref(BindingOfX, SubstBindingOfX, !S),
+ ( SubstBindingOfX = var(Y) ->
+ true
;
- not_occurs(SubstBindingOfX, Y),
- tr_store__set_mutvar(Y, SubstBindingOfX)
+ not_occurs(SubstBindingOfX, Y, !S),
+ tr_store.set_mutvar(Y, SubstBindingOfX, !S)
)
)
;
(
- { BindingOfY \= free }
+ BindingOfY \= free
->
- % X is a variable which hasn't been bound yet
- deref(BindingOfY, SubstBindingOfY),
- ( { SubstBindingOfY = var(X) } ->
- []
+ % X is a variable which hasn't been bound yet.
+ deref(BindingOfY, SubstBindingOfY, !S),
+ ( SubstBindingOfY = var(X) ->
+ true
;
- not_occurs(SubstBindingOfY, X),
- tr_store__set_mutvar(X, SubstBindingOfY)
+ not_occurs(SubstBindingOfY, X, !S),
+ tr_store.set_mutvar(X, SubstBindingOfY, !S)
)
;
- % both X and Y are unbound variables -
- % bind one to the other
- ( { X = Y } ->
- []
+ % Both X and Y are unbound variables -
+ % bind one to the other.
+ ( X = Y ->
+ true
;
- tr_store__set_mutvar(X, var(Y))
+ tr_store.set_mutvar(X, var(Y), !S)
)
)
).
-unify(var(X), functor(F, As)) -->
- tr_store__get_mutvar(X, BindingOfX),
+unify(var(X), functor(F, As), !S) :-
+ tr_store.get_mutvar(X, BindingOfX, !S),
(
- { BindingOfX \= free }
+ BindingOfX \= free
->
- unify(BindingOfX, functor(F, As))
+ unify(BindingOfX, functor(F, As), !S)
;
- not_occurs_list(As, X),
- tr_store__set_mutvar(X, functor(F, As))
+ not_occurs_list(As, X, !S),
+ tr_store.set_mutvar(X, functor(F, As), !S)
).
-unify(functor(F, As), var(X)) -->
- tr_store__get_mutvar(X, BindingOfX),
+unify(functor(F, As), var(X), !S) :-
+ tr_store.get_mutvar(X, BindingOfX, !S),
(
- { BindingOfX \= free }
+ BindingOfX \= free
->
- unify(functor(F, As), BindingOfX)
+ unify(functor(F, As), BindingOfX, !S)
;
- not_occurs_list(As, X),
- tr_store__set_mutvar(X, functor(F, As))
+ not_occurs_list(As, X, !S),
+ tr_store.set_mutvar(X, functor(F, As), !S)
).
-unify(functor(F, AsX), functor(F, AsY)) -->
- unify_list(AsX, AsY).
+unify(functor(F, AsX), functor(F, AsY), !S) :-
+ unify_list(AsX, AsY, !S).
-:- pred unify_list(list(my_term(S)), list(my_term(S)), store(S), store(S)).
-:- mode unify_list(in, in, mdi, muo) is semidet.
+:- pred unify_list(list(my_term(S))::in, list(my_term(S))::in,
+ store(S)::mdi, store(S)::muo) is semidet.
-unify_list([], []) --> [].
-unify_list([X | Xs], [Y | Ys]) -->
- unify(X, Y),
- unify_list(Xs, Ys).
+unify_list([], [], !S).
+unify_list([X | Xs], [Y | Ys], !S) :-
+ unify(X, Y, !S),
+ unify_list(Xs, Ys, !S).
%-----------------------------------------------------------------------------%
@@ -433,60 +435,59 @@
% perhaps indirectly via the substitution in Store0.
% (The variable must not be mapped by the substitution.)
-:- pred not_occurs(my_term(S), my_var(S), store(S), store(S)).
-:- mode not_occurs(in, in, mdi, muo) is semidet.
+:- pred not_occurs(my_term(S)::in, my_var(S)::in,
+ store(S)::mdi, store(S)::muo) is semidet.
-not_occurs(var(X), Y) -->
- { X \= Y },
- tr_store__get_mutvar(X, BindingOfX),
- ( { BindingOfX = free } ->
- []
+not_occurs(var(X), Y, !S) :-
+ X \= Y,
+ tr_store.get_mutvar(X, BindingOfX, !S),
+ ( BindingOfX = free ->
+ true
;
- not_occurs(BindingOfX, Y)
+ not_occurs(BindingOfX, Y, !S)
).
-not_occurs(functor(_F, As), Y) -->
- not_occurs_list(As, Y).
+not_occurs(functor(_F, As), Y, !S) :-
+ not_occurs_list(As, Y, !S).
-:- pred not_occurs_list(list(my_term(S)), my_var(S), store(S), store(S)).
-:- mode not_occurs_list(in, in, mdi, muo) is semidet.
+:- pred not_occurs_list(list(my_term(S))::in, my_var(S)::in,
+ store(S)::mdi, store(S)::muo) is semidet.
-not_occurs_list([], _) --> [].
-not_occurs_list([Term | Terms], Y) -->
- not_occurs(Term, Y),
- not_occurs_list(Terms, Y).
+not_occurs_list([], _, !S).
+not_occurs_list([Term | Terms], Y, !S) :-
+ not_occurs(Term, Y, !S),
+ not_occurs_list(Terms, Y, !S).
%-----------------------------------------------------------------------------%
-% deref(Term0, Term, Store0, Store) :
-% recursively apply substitution to Term0 until
-% no more substitions can be applied, and then
-% return the result in Term.
-
-:- pred deref(my_term(S), my_term(S), store(S), store(S)).
-:- mode deref(in, out, mdi, muo) is det.
+ % deref(Term0, Term, !Store):
+ % Recursively apply substitution to Term0 until no more substitutions can
+ % be applied, and then return the result in Term.
+ %
+:- pred deref(my_term(S)::in, my_term(S)::out, store(S)::mdi, store(S)::muo)
+ is det.
-deref(free, _) -->
- { error("interpreter__deref: unexpected occurence of `free'") }.
-deref(var(Var), Term) -->
- tr_store__get_mutvar(Var, Replacement),
+deref(free, _, _, _) :-
+ error("interpreter.deref: unexpected occurrence of `free'").
+deref(var(Var), Term, !S) :-
+ tr_store.get_mutvar(Var, Replacement, !S),
(
- { Replacement \= free }
+ Replacement \= free
->
- % recursively apply the substition to the replacement
- deref(Replacement, Term)
+ % Recursively apply the substitution to the replacement.
+ deref(Replacement, Term, !S)
;
- { Term = var(Var) }
+ Term = var(Var)
).
-deref(functor(Name, Args0), functor(Name, Args)) -->
- deref_list(Args0, Args).
+deref(functor(Name, Args0), functor(Name, Args), !S) :-
+ deref_list(Args0, Args, !S).
-:- pred deref_list(list(my_term(S)), list(my_term(S)), store(S), store(S)).
-:- mode deref_list(in, out, mdi, muo) is det.
+:- pred deref_list(list(my_term(S))::in, list(my_term(S))::out,
+ store(S)::mdi, store(S)::muo) is det.
-deref_list([], []) --> [].
-deref_list([Term0 | Terms0], [Term | Terms]) -->
- deref(Term0, Term),
- deref_list(Terms0, Terms).
+deref_list([], [], !S).
+deref_list([Term0 | Terms0], [Term | Terms], !S) :-
+ deref(Term0, Term, !S),
+ deref_list(Terms0, Terms, !S).
%-----------------------------------------------------------------------------%
@@ -494,34 +495,41 @@
% and for each predicate the clauses are indexed according to the
% name/arity of their first argument.
-:- type database ---> database(
- list(clause), % clauses with variable as head
- map(string/int, db_pred) % preds, indexed on name/arity
- ).
-:- type db_pred ---> db_pred(
- list(clause), % unindexed clauses
- % (ones with var as first arg,
- % or with no args)
- multi_map(string/int, clause) % clauses, indexed on the
- % name/arity of first arg
- ).
+:- type database
+ ---> database(
+ list(clause),
+ % Clauses with variable as head.
+
+ map(string/int, db_pred)
+ % Preds, indexed on name/arity.
+ ).
+
+:- type db_pred
+ ---> db_pred(
+ list(clause),
+ % Unindexed clauses
+ % (ones with var as first arg, or with no args).
+
+ multi_map(string/int, clause)
+ % Clauses, indexed on the name/arity of first arg.
+ ).
:- type Name/Arity ---> Name/Arity.
-:- type clause ---> clause(varset, term, term). % varset, head, body
+:- type clause
+ ---> clause(varset, term, term). % varset, head, body
-:- pred database_init(database).
-:- mode database_init(out) is det.
+:- pred database_init(database::out) is det.
database_init(database([], Preds)) :-
- map__init(Preds).
+ map.init(Preds).
-:- pred database_assert_clause(database, varset, term, database).
-:- mode database_assert_clause(in, in, in, out) is det.
+:- pred database_assert_clause(varset::in, term::in,
+ database::in, database::out) is det.
-database_assert_clause(Database0, VarSet, Term, Database) :-
+database_assert_clause(VarSet, Term, !Database) :-
%
- % add `:- true' if clause not already in the form `H :- B'
+ % Add `:- true' if clause not already in the form `H :- B'.
%
( Term = functor(atom(":-"), [H, B], _) ->
Head = H,
@@ -534,96 +542,96 @@
Clause = clause(VarSet, Head, Body),
%
- % insert clause into database
+ % Insert clause into database.
%
- Database0 = database(UnindexedClauses, Preds0),
+ !.Database = database(UnindexedClauses, Preds0),
( Head = functor(atom(PredName), PredArgs, _) ->
%
- % we can do predicate name/arity indexing
+ % We can do predicate name/arity indexing.
%
- list__length(PredArgs, PredArity),
+ list.length(PredArgs, PredArity),
PredId = PredName / PredArity,
(
PredArgs = [FirstArg | _],
FirstArg = functor(atom(FirstArgName), FirstArgArgs, _)
->
+ % We can do first-argument name/arity indexing.
%
- % we can do first-argument name/arity indexing
- %
- list__length(FirstArgArgs, FirstArgArity),
+ list.length(FirstArgArgs, FirstArgArity),
FirstArgId = FirstArgName / FirstArgArity,
- ( map__search(Preds0, PredId, Pred0) ->
+ ( map.search(Preds0, PredId, Pred0) ->
Pred0 = db_pred(PredUnindexedClauses,
- PredIndexedClauses0),
- multi_map__set(PredIndexedClauses0, FirstArgId,
+ PredIndexedClauses0),
+ multi_map.set(PredIndexedClauses0, FirstArgId,
Clause, PredIndexedClauses),
Pred = db_pred(PredUnindexedClauses,
- PredIndexedClauses),
- map__det_update(Preds0, PredId, Pred, Preds)
+ PredIndexedClauses),
+ map.det_update(Preds0, PredId, Pred, Preds)
;
- multi_map__init(PredIndexedClauses0),
- multi_map__set(PredIndexedClauses0, FirstArgId,
+ multi_map.init(PredIndexedClauses0),
+ multi_map.set(PredIndexedClauses0, FirstArgId,
Clause, PredIndexedClauses),
Pred = db_pred([], PredIndexedClauses),
- map__det_insert(Preds0, PredId, Pred, Preds)
+ map.det_insert(Preds0, PredId, Pred, Preds)
)
;
+ % We can't do first-argument indexing -- just
+ % insert into the unindexed clauses.
%
- % we can't do first-argument indexing -- just
- % insert into the unindexed clauses
- %
- ( map__search(Preds0, PredId, Pred0) ->
+ ( map.search(Preds0, PredId, Pred0) ->
Pred0 = db_pred(PredUnindexedClauses,
PredIndexedClauses),
Pred = db_pred([Clause | PredUnindexedClauses],
PredIndexedClauses),
- map__det_update(Preds0, PredId, Pred, Preds)
+ map.det_update(Preds0, PredId, Pred, Preds)
;
- multi_map__init(PredIndexedClauses),
+ multi_map.init(PredIndexedClauses),
Pred = db_pred([Clause], PredIndexedClauses),
- map__det_insert(Preds0, PredId, Pred, Preds)
+ map.det_insert(Preds0, PredId, Pred, Preds)
)
),
- Database = database(UnindexedClauses, Preds)
+ !:Database = database(UnindexedClauses, Preds)
;
- Database = database([Clause|UnindexedClauses], Preds0)
+ !:Database = database([Clause | UnindexedClauses], Preds0)
).
-:- pred database_lookup_clause(database, my_term(_), varset, term, term).
-:- mode database_lookup_clause(in, in, out, out, out) is nondet.
+:- pred database_lookup_clause(database::in, my_term(_)::in, varset::out,
+ term::out, term::out) is nondet.
database_lookup_clause(Database, Goal, VarSet, Head, Body) :-
database_lookup_clause(Database, Goal, Clause),
Clause = clause(VarSet, Head, Body).
-:- pred database_lookup_clause(database, my_term(_), clause).
-:- mode database_lookup_clause(in, in, out) is nondet.
+:- pred database_lookup_clause(database::in, my_term(_)::in, clause::out)
+ is nondet.
database_lookup_clause(database(Clauses, _Preds), _Goal, Clause) :-
- list__member(Clause, Clauses).
+ list.member(Clause, Clauses).
database_lookup_clause(database(_Clauses, Preds), Goal, Clause) :-
Goal = functor(atom(PredName), PredArgs),
- list__length(PredArgs, PredArity),
- map__search(Preds, PredName/PredArity, PredClauses),
+ list.length(PredArgs, PredArity),
+ map.search(Preds, PredName/PredArity, PredClauses),
database_lookup_pred_clause(PredClauses, PredArgs, Clause).
-:- pred database_lookup_pred_clause(db_pred, list(my_term(_)), clause).
-:- mode database_lookup_pred_clause(in, in, out) is nondet.
+:- pred database_lookup_pred_clause(db_pred::in, list(my_term(_))::in,
+ clause::out) is nondet.
database_lookup_pred_clause(db_pred(Clauses, _IndexedClauses), _, Clause) :-
- list__member(Clause, Clauses).
+ list.member(Clause, Clauses).
database_lookup_pred_clause(db_pred(_, IndexedClauses), PredArgs, Clause) :-
PredArgs = [FirstArg | _],
(
FirstArg = var(_),
- multi_map__member(IndexedClauses, _, Clause)
+ multi_map.member(IndexedClauses, _, Clause)
;
FirstArg = functor(atom(FirstArgName), FirstArgArgs),
- list__length(FirstArgArgs, FirstArgArity),
- multi_map__nondet_lookup(IndexedClauses,
+ list.length(FirstArgArgs, FirstArgArity),
+ multi_map.nondet_lookup(IndexedClauses,
FirstArgName/FirstArgArity, Clause)
).
%-----------------------------------------------------------------------------%
+:- end_module interpreter.
+%-----------------------------------------------------------------------------%
Index: tests/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/trailed_update/tests/Mmakefile,v
retrieving revision 1.12
diff -u -r1.12 Mmakefile
--- tests/Mmakefile 31 Jul 2007 07:58:43 -0000 1.12
+++ tests/Mmakefile 16 Dec 2010 14:59:49 -0000
@@ -7,7 +7,7 @@
MAIN_TARGET = all
# We need to use a grade with trailing
-GRADEFLAGS += --use-trail
+GRADEFLAGS += --use-trail --trail-segments
MCFLAGS = --infer-all
Index: tests/var_test.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/trailed_update/tests/var_test.m,v
retrieving revision 1.1
diff -u -r1.1 var_test.m
--- tests/var_test.m 2 Jun 1998 05:32:26 -0000 1.1
+++ tests/var_test.m 16 Dec 2010 14:59:49 -0000
@@ -1,12 +1,16 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
% Copyright (C) 1997 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
+%
% Some test cases for extras/trailed_update/var.m.
-
+%
% author: fjh
+%
+%-----------------------------------------------------------------------------%
:- module var_test.
@@ -14,133 +18,152 @@
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is cc_multi.
+:- pred main(io::di, io::uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module var.
-:- import_module require, int, std_util.
+
:- import_module unsafe.
+:- import_module var.
-main -->
- print("test_delaying_1: "),
- ( { test_delaying_1 } ->
- print("yes"), nl
- ;
- print("no"), nl
- ),
- print("test_delaying_2: "),
- ( { test_delaying_2 } ->
- print("yes"), nl
- ;
- print("no"), nl
- ),
-
- ( { create_solvable_delayed_goal(X, Y) } ->
- print("X = "), output_var(X), nl,
- print("Y = "), output_var(Y), nl
- ;
- print("Oops.\n")
- ),
-
- print("test_delaying_1: "),
- ( { test_delaying_1 } ->
- print("yes"), nl
- ;
- print("no"), nl
- ),
- print("test_delaying_2: "),
- ( { test_delaying_2 } ->
- print("yes"), nl
- ;
- print("no"), nl
- ),
-
- print("test_delaying_3: "),
- ( { create_solvable_delayed_goal(X3, Y3) } ->
- print("yes: X = "), output_var(X3),
- print(", Y = "), output_var(Y3), nl
- ;
- print("no"), nl
- ),
- print("test_delaying_4: "),
- ( { create_unsolvable_delayed_goal(X4) } ->
- print("yes: X = "), output_var(X4), nl
- ;
- print("no"), nl
- ),
- print("test_ground:"), nl,
- { Z = var(42) },
- print("Z = "), output_var(Z), nl,
- ( { var__init(Z2), var__init(Z3), Z2 = Z3, Z3 = Z } ->
- print("Z2 = "), output_var(Z2), nl
- ;
- print("oops"), nl
- ),
- print("test_alias_twice:"), nl,
- ( { A == B, A = B } ->
- print("A = "), output_var(A), nl,
- print("B = "), output_var(B), nl
- ;
- print("oops"), nl
- ),
- print("test_dup_call_bug:"), nl,
- ( { var__init(A1), var__init(A2), A1 = var(42) } ->
- print("A1 = "), output_var(A1), nl,
- print("A2 = "), output_var(A2), nl
- ;
- print("oops"), nl
- ),
- print("Done.\n").
+:- import_module int.
+:- import_module require.
+:- import_module std_util.
+
+:- pragma require_feature_set([trailing]).
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ print("test_delaying_1: ", !IO),
+ ( test_delaying_1 ->
+ print("yes\n", !IO)
+ ;
+ print("no\n", !IO)
+ ),
+
+ print("test_delaying_2: ", !IO),
+ ( test_delaying_2 ->
+ print("yes\n", !IO)
+ ;
+ print("no\n", !IO)
+ ),
+
+ ( create_solvable_delayed_goal(X, Y) ->
+ print("X = ", !IO), output_var(X, !IO), nl(!IO),
+ print("Y = ", !IO), output_var(Y, !IO), nl(!IO)
+ ;
+ print("Oops.\n", !IO)
+ ),
+
+ print("test_delaying_1: ", !IO),
+ ( test_delaying_1 ->
+ print("yes\n", !IO)
+ ;
+ print("no\n", !IO)
+ ),
+
+ print("test_delaying_2: ", !IO),
+ ( test_delaying_2 ->
+ print("yes\n", !IO)
+ ;
+ print("no\n", !IO)
+ ),
+
+ print("test_delaying_3: ", !IO),
+ ( create_solvable_delayed_goal(X3, Y3) ->
+ print("yes: X = ", !IO), output_var(X3, !IO),
+ print(", Y = ", !IO), output_var(Y3, !IO), nl(!IO)
+ ;
+ print("no\n", !IO)
+ ),
+
+ print("test_delaying_4: ", !IO),
+ ( create_unsolvable_delayed_goal(X4) ->
+ print("yes: X = ", !IO), output_var(X4, !IO), nl(!IO)
+ ;
+ print("no\n", !IO)
+ ),
+
+ print("test_ground:\n", !IO),
+ Z = var(42),
+ print("Z = ", !IO), output_var(Z, !IO), nl(!IO),
+ ( var.init(Z2), var.init(Z3), Z2 = Z3, Z3 = Z ->
+ print("Z2 = ", !IO), output_var(Z2, !IO), nl(!IO)
+ ;
+ print("oops\n", !IO)
+ ),
+ print("test_alias_twice:\n", !IO),
+ ( A == B, A = B ->
+ print("A = ", !IO), output_var(A, !IO), nl(!IO),
+ print("B = ", !IO), output_var(B, !IO), nl(!IO)
+ ;
+ print("oops\n", !IO)
+ ),
+ print("test_dup_call_bug:\n", !IO),
+ ( var.init(A1), var.init(A2), A1 = var(42) ->
+ print("A1 = ", !IO), output_var(A1, !IO), nl(!IO),
+ print("A2 = ", !IO), output_var(A2, !IO), nl(!IO)
+ ;
+ print("oops\n", !IO)
+ ),
+ print("Done.\n", !IO).
:- mode output_var(in(any), di, uo) is cc_multi.
-output_var(Var) -->
- dump_var(Var),
- { var__is_ground(Var, MaybeVal) },
- print(" [ground: "), write(MaybeVal), print("]").
+
+output_var(Var, !IO) :-
+ dump_var(Var, !IO),
+ var.is_ground(Var, MaybeVal),
+ print(" [ground: ", !IO), write(MaybeVal, !IO), print("]", !IO).
test_delaying_1 :-
- create_solvable_delayed_goal(X, Y),
- wake_and_fail(X, Y).
+ create_solvable_delayed_goal(X, Y),
+ wake_and_fail(X, Y).
test_delaying_2 :-
- create_solvable_delayed_goal(X, Y),
- wake_and_succeed(X, Y).
+ create_solvable_delayed_goal(X, Y),
+ wake_and_succeed(X, Y).
create_solvable_delayed_goal(X, Y) :-
- % debug_freeze("add_one",
- freeze(
- X, (pred(XVal::in, YVal::out) is det :-
- YVal = XVal + 1), Y).
+ % debug_freeze("add_one",
+ freeze(X, (pred(XVal::in, YVal::out) is det :- YVal = XVal + 1), Y).
wake_and_succeed(var(0), var(1)). % 1 = 0 + 1 succeeds
-% unsafe_perform_io(print("Y = ")),
-% unsafe_perform_io(output_var(Y)),
-% unsafe_perform_io(nl).
+% unsafe_perform_io(print("Y = ")),
+% unsafe_perform_io(output_var(Y)),
+% unsafe_perform_io(nl).
wake_and_fail(var(0), var(42)). % 42 = 0 + 1 fails.
create_unsolvable_delayed_goal(X) :-
- init(X),
- % debug_freeze("always_fail",
- freeze(
- X, (pred(_::in) is semidet :- fail)).
+ init(X),
+ % debug_freeze("always_fail",
+ freeze(X, (pred(_::in) is semidet :- fail)).
% :- mode test_modes_1. (not yet supported)
test_modes_1 :-
- % test auto-initialize (implied free -> any)
- p(_),
- p2(_).
+ % test auto-initialize (implied free -> any)
+ p(_),
+ p2(_).
:- mode test_modes_2(in(any)).
test_modes_2(X) :-
- % test implied mode
- q(X).
+ % test implied mode
+ q(X).
-:- mode p(any -> any) is semidet.
+:- mode p(ia) is semidet.
p(_) :- semidet_succeed.
-:- mode p2(any -> ground) is failure.
+:- mode p2(any >> ground) is failure.
+
p2(_) :- fail.
-:- mode q(free -> any) is det.
+:- mode q(oa) is det.
+
q(X) :- init(X).
+
+%-----------------------------------------------------------------------------%
+:- end_module var_test.
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list