🚀 go-pugleaf

Just to show that I haven't got my knife exclusively into WG17,
here's a report on what I found when I applied the "touchstone"
(how does the book explain findall/bagof/setof, does their code
work) to the book "The Art of Prolog" by Sterling and Shapiro.

/*  This is Program 17.3  "Implementing a set predicate using
			   difference-lists, assert, and retract"
    from section 17.1, page 270, of "The Art of Prolog" by
    Sterling and Shapiro, 1986.
*/

find_all_dl(X, Goal, Xs) :-		% Bug 4 (Xs should be Xs-Ys, or)
	asserta('$instance'('$mark')),	% Bug 1 ($mark looks like a solution)
	Goal,
	asserta('$instance'(X)),	% Bug 1 ($mark looks like a solution)
	fail.
find_all_dl(X, Goal, Xs-Ys) :-		% Bug 4 (Xs-Ys should be Xs)
	retract('$instance'(X)),	% Bug 2 (X becomes last answer or $mark)
	reap(X, Xs-Ys),
	!.				% Bug 3 (cut should precede reap)

reap(X, Xs-Ys) :-
	X \== '$mark',
	retract('$instance'(X1)),
	!,
	reap(X1, Xs-[X|Ys]).
reap('$mark', Xs-Xs).


/*  The following tests illustrate problems with that definition
*/

test_1 :-			% Bug 2
	find_all_dl(., fail, L),
	write(L).		% Should be Z-Z
				% INSTEAD:  fails,
				% and leaves $instance($mark) in data base.

test_2 :-			% Bug 2
	find_all_dl(X, fail, L),
	write((X, L)).		% Should be _, Z-Z
				% INSTEAD:  '$mark', Z-Z

test_3 :-			% Bug 2
	find_all_dl(X, (X = *;X = /), L),
	write((X, L)).		% Should be _, [*,/|Z]-Z
				% INSTEAD:  /, [*,/|Z]-Z

test_4 :-			% Bug 1
	find_all_dl(X, (X = '$instance';X = '$mark'), L),
	write(L).		% Should be ['$instance','$mark'|Z]-Z
				% INSTEAD:  Z-Z, and leaves
				% $instance($instance), $instance($mark)
				% behind in the data base.

/*  This looks as though the inner find_all_dl is stealing solutions
    from the outer one, but in fact the problem is the *extra*
    $instance($mark) it leaves behind.
*/
test_5 :-			% Bug 4
	find_all_dl(X, (X = a ; X = b ; X = c ;
	    find_all_dl(Y, fail, *), X = d), L),
	write(L).		% Should be [a,b,c|Z]-Z
				% INSTEAD:  Z-Z, and leaves
				% $mark, a, b, c in $instance data base.

/*  The text says 'Asserting "$mark" is essential for nested
    set-expressions to work correctly, lest one set would "steal"
    solutions produced by the other set-expression.'  test_5
    shows how an inner find_all_dl _may_ steal (all the) solutions
    from an outer find_all_dl.
*/
test_6 :-			% Bug 3 and Bug 4
	find_all_dl(X, (X = a ; X = b ; X = c ;
	    find_all_dl(Y, fail, x-y), X = d), L),
	write(L).		% Should be [a,b,c|Z]-Z
				% INSTEAD:  fails, and leaves
				% the data base empty.
end_of_file.