[m-rev.] for review: use include_details_cc for interactive queries
Fergus Henderson
fjh at cs.mu.OZ.AU
Fri Mar 8 01:48:24 AEDT 2002
Note that this change depends on the change I posted earlier
to add `io__write_cc'. Changing it to use `io__write/5' instead
would not be trivial.
----------
Estimated hours taken: 2
Branches: main
Get the debugger's interactive query mechanism to print out details of
non-canonical types (e.g. higher-order types).
browser/interactive_query.m:
Use `io__write_cc' rather than `io__write', and hence declare the
argument passed to `builtin_aggregate' as `cc_multi' rather than `det'.
library/std_util.m:
Add modes to `builtin_aggregate' and `do_while' in which the
collector predicate has determinism `cc_multi'.
library/builtin.m:
Add impure variants of `promise_only_solution' and
`promise_only_solution_io', for use by std_util.m.
Workspace: /home/ceres/fjh/mercury
Index: browser/interactive_query.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/interactive_query.m,v
retrieving revision 1.12
diff -u -d -r1.12 interactive_query.m
--- browser/interactive_query.m 27 Feb 2002 09:38:30 -0000 1.12
+++ browser/interactive_query.m 7 Mar 2002 14:31:37 -0000
@@ -244,10 +244,10 @@
unsorted_aggregate(
(pred(res(A,B,C)::out) is nondet :-
query(A,B,C)),
- (pred(res(A,B,C)::in, di, uo) -->
- print("A = "), print(A), print(","),
- print("B = "), print(B), print(","),
- print("C = "), print(C), print(","),
+ (pred(res(A,B,C)::in, di, uo) is cc_multi -->
+ print("A = "), print_cc(A), print(","),
+ print("B = "), print_cc(B), print(","),
+ print("C = "), print_cc(C), print(","),
print("true ;\n"))
),
print(""fail.\n""),
@@ -256,7 +256,7 @@
:- type res(A, B, C) ---> res(A, B, C).
% :- mode query(out, out, out) is nondet.
- query(res(A, B, C, D)) :-
+ query(res(A, B, C)) :-
...
*/
io__write_string("
@@ -269,7 +269,7 @@
io__write_string("),"),
io__write_string("(pred(res"),
write_args(Vars, VarSet),
- io__write_string("::in, di, uo) is det -->
+ io__write_string("::in, di, uo) is cc_multi -->
"),
list__foldl(write_code_to_print_one_var(VarSet), Vars),
io__write_string("
@@ -364,7 +364,7 @@
write_code_to_print_one_var(VarSet, Var) -->
io__write_string("io__write_string("""),
term_io__write_variable(Var, VarSet),
- io__write_string(" = ""), write("),
+ io__write_string(" = ""), io__write_cc("),
term_io__write_variable(Var, VarSet),
print("), io__write_string("", ""), ").
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.68
diff -u -d -r1.68 builtin.m
--- library/builtin.m 18 Feb 2002 07:01:02 -0000 1.68
+++ library/builtin.m 7 Mar 2002 14:46:52 -0000
@@ -219,52 +219,83 @@
% call/N
%-----------------------------------------------------------------------------%
+:- implementation.
+
+% Everything below here is not intended to be part of the public interface,
+% and will not be included in the Mercury library reference manual.
+
+%-----------------------------------------------------------------------------%
+:- interface.
+
+% `get_one_solution' and `get_one_solution_io' are impure alternatives
+% to `promise_one_solution' and `promise_one_solution_io', respectively.
+% They get a solution to the procedure, without requiring any promise
+% that there is only one solution. However, they can only be used in
+% impure code.
+
+:- impure func get_one_solution(pred(T)) = T.
+:- mode get_one_solution(pred(out) is cc_multi) = out is det.
+:- mode get_one_solution(pred(out) is cc_nondet) = out is semidet.
+
+:- impure pred get_one_solution_io(pred(T, IO, IO), T, IO, IO).
+:- mode get_one_solution_io(pred(out, di, uo) is cc_multi,
+ out, di, uo) is det.
:- implementation.
:- import_module require, string, std_util, int, float, char, string, list.
%-----------------------------------------------------------------------------%
-promise_only_solution(Pred) = OutVal :-
- call(cc_cast(Pred), OutVal).
+:- pragma promise_pure(promise_only_solution/1).
+promise_only_solution(CCPred) = OutVal :-
+ impure OutVal = get_one_solution(CCPred).
-:- func cc_cast(pred(T)) = pred(T).
+get_one_solution(CCPred) = OutVal :-
+ impure Pred = cc_cast(CCPred),
+ call(Pred, OutVal).
+
+:- impure func cc_cast(pred(T)) = pred(T).
:- mode cc_cast(pred(out) is cc_nondet) = out(pred(out) is semidet) is det.
:- mode cc_cast(pred(out) is cc_multi) = out(pred(out) is det) is det.
:- pragma foreign_proc("C", cc_cast(X :: (pred(out) is cc_multi)) =
(Y :: out(pred(out) is det)),
- [will_not_call_mercury, promise_pure, thread_safe],
+ [will_not_call_mercury, thread_safe],
"Y = X;").
:- pragma foreign_proc("C", cc_cast(X :: (pred(out) is cc_nondet)) =
(Y :: out(pred(out) is semidet)),
- [will_not_call_mercury, promise_pure, thread_safe],
+ [will_not_call_mercury, thread_safe],
"Y = X;").
:- pragma foreign_proc("C#", cc_cast(X :: (pred(out) is cc_multi)) =
(Y :: out(pred(out) is det)),
- [will_not_call_mercury, promise_pure, thread_safe],
+ [will_not_call_mercury, thread_safe],
"Y = X;").
:- pragma foreign_proc("C#", cc_cast(X :: (pred(out) is cc_nondet)) =
(Y :: out(pred(out) is semidet)),
- [will_not_call_mercury, promise_pure, thread_safe],
+ [will_not_call_mercury, thread_safe],
"Y = X;").
+:- pragma promise_pure(promise_only_solution_io/4).
promise_only_solution_io(Pred, X) -->
- call(cc_cast_io(Pred), X).
+ impure get_one_solution_io(Pred, X).
-:- func cc_cast_io(pred(T, IO, IO)) = pred(T, IO, IO).
+get_one_solution_io(Pred, X) -->
+ { impure DetPred = cc_cast_io(Pred) },
+ call(DetPred, X).
+
+:- impure func cc_cast_io(pred(T, IO, IO)) = pred(T, IO, IO).
:- mode cc_cast_io(pred(out, di, uo) is cc_multi) =
out(pred(out, di, uo) is det) is det.
:- pragma foreign_proc("C",
cc_cast_io(X :: (pred(out, di, uo) is cc_multi)) =
(Y :: out(pred(out, di, uo) is det)),
- [will_not_call_mercury, promise_pure, thread_safe],
+ [will_not_call_mercury, thread_safe],
"Y = X;").
:- pragma foreign_proc("C#",
cc_cast_io(X :: (pred(out, di, uo) is cc_multi)) =
(Y :: out(pred(out, di, uo) is det)),
- [will_not_call_mercury, promise_pure, thread_safe],
+ [will_not_call_mercury, thread_safe],
"Y = X;").
%-----------------------------------------------------------------------------%
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.263
diff -u -d -r1.263 std_util.m
--- library/std_util.m 18 Feb 2002 07:01:07 -0000 1.263
+++ library/std_util.m 7 Mar 2002 14:34:56 -0000
@@ -221,10 +221,14 @@
in, out) is cc_multi.
:- mode unsorted_aggregate(pred(out) is multi, pred(in, di, uo) is det,
di, uo) is cc_multi.
+:- mode unsorted_aggregate(pred(out) is multi, pred(in, di, uo) is cc_multi,
+ di, uo) is cc_multi.
:- mode unsorted_aggregate(pred(muo) is multi, pred(mdi, di, uo) is det,
di, uo) is cc_multi.
:- mode unsorted_aggregate(pred(out) is nondet, pred(in, di, uo) is det,
di, uo) is cc_multi.
+:- mode unsorted_aggregate(pred(out) is nondet, pred(in, di, uo) is cc_multi,
+ di, uo) is cc_multi.
:- mode unsorted_aggregate(pred(out) is nondet, pred(in, in, out) is det,
in, out) is cc_multi.
:- mode unsorted_aggregate(pred(muo) is nondet, pred(mdi, di, uo) is det,
@@ -254,12 +258,16 @@
:- pred do_while(pred(T), pred(T, bool, T2, T2), T2, T2).
:- mode do_while(pred(out) is multi, pred(in, out, in, out) is det, in, out)
is cc_multi.
-:- mode do_while(pred(out) is nondet, pred(in, out, in, out) is det, in, out)
- is cc_multi.
:- mode do_while(pred(out) is multi, pred(in, out, di, uo) is det, di, uo)
is cc_multi.
+:- mode do_while(pred(out) is multi, pred(in, out, di, uo) is cc_multi, di, uo)
+ is cc_multi.
+:- mode do_while(pred(out) is nondet, pred(in, out, in, out) is det, in, out)
+ is cc_multi.
:- mode do_while(pred(out) is nondet, pred(in, out, di, uo) is det, di, uo)
is cc_multi.
+:- mode do_while(pred(out) is nondet, pred(in, out, di, uo) is cc_multi, di, uo)
+ is cc_multi.
%-----------------------------------------------------------------------------%
@@ -753,10 +761,14 @@
in, out) is det. /* really cc_multi */
:- mode builtin_aggregate(pred(out) is multi, pred(in, di, uo) is det,
di, uo) is det. /* really cc_multi */
+:- mode builtin_aggregate(pred(out) is multi, pred(in, di, uo) is cc_multi,
+ di, uo) is det. /* really cc_multi */
:- mode builtin_aggregate(pred(muo) is multi, pred(mdi, di, uo) is det,
di, uo) is det. /* really cc_multi */
:- mode builtin_aggregate(pred(out) is nondet, pred(in, di, uo) is det,
di, uo) is det. /* really cc_multi */
+:- mode builtin_aggregate(pred(out) is nondet, pred(in, di, uo) is cc_multi,
+ di, uo) is det. /* really cc_multi */
:- mode builtin_aggregate(pred(out) is nondet, pred(in, in, out) is det,
in, out) is det. /* really cc_multi */
:- mode builtin_aggregate(pred(muo) is nondet, pred(mdi, di, uo) is det,
@@ -834,7 +846,7 @@
impure swap_heap_and_solutions_heap,
impure partial_deep_copy(HeapPtr, Answer0, Answer),
impure get_mutvar(Mutvar, Acc0),
- CollectorPred(Answer, Acc0, Acc1),
+ impure non_cc_call(CollectorPred, Answer, Acc0, Acc1),
impure set_mutvar(Mutvar, Acc1),
impure swap_heap_and_solutions_heap,
@@ -878,7 +890,7 @@
impure swap_heap_and_solutions_heap,
impure partial_deep_copy(HeapPtr, Answer0, Answer),
impure get_mutvar(Mutvar, Acc0),
- CollectorPred(Answer, More, Acc0, Acc1),
+ impure non_cc_call(CollectorPred, Answer, More, Acc0, Acc1),
impure set_mutvar(Mutvar, Acc1),
impure swap_heap_and_solutions_heap,
@@ -892,6 +904,44 @@
impure partial_deep_copy(SolutionsHeapPtr, Accumulator1, Accumulator),
impure reset_solutions_heap(SolutionsHeapPtr),
impure discard_trail_ticket.
+
+ % This is the same as call/4, except that it is not cc_multi
+ % even when the called predicate is cc_multi.
+:- impure pred non_cc_call(pred(T, Acc, Acc), T, Acc, Acc).
+:- mode non_cc_call(pred(in, in, out) is det, in, in, out) is det.
+:- mode non_cc_call(pred(in, di, uo) is det, in, di, uo) is det.
+:- mode non_cc_call(pred(in, di, uo) is cc_multi, in, di, uo) is det.
+:- mode non_cc_call(pred(mdi, di, uo) is det, mdi, di, uo) is det.
+non_cc_call(P::pred(in, in, out) is det, X::in, Acc0::in, Acc::out) :-
+ P(X, Acc0, Acc).
+non_cc_call(P::pred(in, di, uo) is cc_multi, X::in, Acc0::di, Acc::uo) :-
+ impure builtin__get_one_solution_io(
+ (pred({}::out, di, uo) is cc_multi --> P(X)),
+ _, Acc0, Acc).
+non_cc_call(P::pred(in, di, uo) is det, X::in, Acc0::di, Acc::uo) :-
+ P(X, Acc0, Acc).
+non_cc_call(P::pred(mdi, di, uo) is det, X::mdi, Acc0::di, Acc::uo) :-
+ P(X, Acc0, Acc).
+
+ % This is the same as call/5, except that it is not cc_multi
+ % even when the called predicate is cc_multi.
+:- impure pred non_cc_call(pred(T1, T2, Acc, Acc), T1, T2, Acc, Acc).
+:- mode non_cc_call(pred(in, out, in, out) is det, in, out, in, out)
+ is det.
+:- mode non_cc_call(pred(in, out, di, uo) is det, in, out, di, uo) is det.
+:- mode non_cc_call(pred(in, out, di, uo) is cc_multi, in, out, di, uo)
+ is det.
+non_cc_call(P::pred(in, out, di, uo) is det, X::in, More::out,
+ Acc0::di, Acc::uo) :-
+ P(X, More, Acc0, Acc).
+non_cc_call(P::pred(in, out, in, out) is det, X::in, More::out,
+ Acc0::in, Acc::out) :-
+ P(X, More, Acc0, Acc).
+non_cc_call(P::pred(in, out, di, uo) is cc_multi, X::in, More::out,
+ Acc0::di, Acc::uo) :-
+ impure builtin__get_one_solution_io(
+ (pred(M::out, di, uo) is cc_multi --> P(X, M)),
+ More, Acc0, Acc).
:- type heap_ptr ---> heap_ptr(c_pointer).
:- type trail_ptr ---> trail_ptr(c_pointer).
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
The University of Melbourne | of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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