% Meta-interpreter to internalize backtracking
% Author: Frank Pfenning

% inherit unification (actually only matching)
% make subgoal order, clause order explicit via completion
%
% meta-interpreter succeeds either way and prints
% either "istrue" or "isfalse"
%
% requirements: all goals and subgoals must be ground
% there is exactly on clause head matching each ground atomic goal
% use equality, disjunction, and falsehood to obtain backtracking
% (see member_/2 and append_/3 below for examples)

% declare example predicates dynamic so they can be matched with clause/2
:- dynamic([diverge/0,member_/2,append_/3]). 

% problem workaround: clause((X = Y), _) signals error instead of failing
clause_((X = Y), _) :- !, fail.
clause_(P, B) :- clause(P, B).

% solve(A, S, F, istrue) if solving (A and S) or F succeeds
% solve(A, S, F, isfalse) if solving (A and S) or F fails finitely
% solve(A, S, F, J) diverges otherwise
% see requirements above
solve(true, true, _, istrue).			% stop on first solution
solve(true, (A , S), F, J) :- solve(A, S, F, J).
solve((A , B), S, F, J) :- solve(A, (B, S), F, J).
solve(fail, _, fail, isfalse).
solve(fail, _, ((B , S) ; F), J) :- solve(B, S, F, J).
solve((A ; B), S, F, J) :- solve(A, S, ((B , S) ; F), J).
solve((X = Y), S, F, J) :- X = Y, solve(true, S, F, J).
solve((X = Y), S, F, J) :- X \= Y, solve(fail, S, F, J).
solve(P, S, F, J) :- clause_(P, B), solve(B, S, F, J).

% top level interface
solve(A, J) :- solve(A, true, fail, J).

% member_(X, Ys) iff X is a member of the list Ys
% will succeed multiple times for each member of Ys equal to X.
% member_(X, Ys) is identical to built-in member(X, Ys)
%
% rewritten so that every ground goal matches a unique clause head

member_(X, []) :- fail.
member_(X, [Y|Ys]) :- X = Y ; member_(X, Ys).

% append_(Xs, Ys, Zs) iff Zs is the result of appending list Ys to list Xs
% rewritten so that every ground goal matches a unique clause head
append_([], Ys, Zs) :- Ys = Zs.
append_([X|Xs], Ys, []) :- fail.
append_([X|Xs], Ys, [Z|Zs]) :- X = Z, append_(Xs, Ys, Zs). 

% diverge will never terminate
diverge :- diverge ; true.