% Meta-interpreter to internalize backtracking and unification
% Author: Frank Pfenning
:- op(200, xfy, '\\').  % for queues in infix notation

% meta-interpreter succeeds either way and prints
% either "success" or "failure", allows multiple solutions
%
% declare example predicates dynamic so they can be matched with clause/2

% solve(G, Gamma, S, F, N, J)
% Gamma |- G / S / F, N is next free variable, J = success or failure
% Gamma must already be residuated
solve(top, _, top, _, _, success).
solve(top, Gamma, top, F, N, J) :-  % fail from success for more solns
	solve(bot, Gamma, top, F, N, J).
solve(top, Gamma, and(G, S), F, N, J) :-
	solve(G, Gamma, S, F, N, J).
solve(and(G1, G2), Gamma, S, F, N, J) :-
	solve(G1, Gamma, and(G2, S), F, N, J).
solve(bot, _, _, bot, _, failure).
solve(bot, Gamma, _, or(and(G2, S), F), N, J) :-
	solve(G2, Gamma, S, F, N, J).
solve(or(G1, G2), Gamma, S, F, N, J) :-
	solve(G1, Gamma, S, or(and(G2, S), F), N, J).
solve(equal(T1, T2), Gamma, S, F, N, J) :-
	unify(T1, T2, Theta) ->
	( apply_prop(S, Theta, STheta),
	  solve(top, Gamma, STheta, F, N, J) )
      ;
	solve(bot, Gamma, S, F, N, J).
solve(exists(X, G), Gamma, S, F, N, J) :-
	apply_prop(G, [for(var(N),X)], G1),
	N1 is N+1,
	solve(G1, Gamma, S, F, N1, J).
solve(app(Pred, Ts), Gamma, S, F, N, J) :-
	length(Ts, Arity),
	memberchk(prog(Pred/Arity, implies(G, app(Pred, Args))), Gamma),
	zip_subst(Ts, Args, Theta),
	apply_prop(G, Theta, GTheta),
	solve(GTheta, Gamma, S, F, N, J).

% N = next free variable
% Gamma |- G, N is next free variable, J = success of failure
solve(G, Gamma, N, J) :- solve(G, Gamma, top, bot, N, J).

% prove(G, Gamma, S, F1\F2, N, J)
% Gamma |- G / S / FQ, N is next free variable, J = success or failure
% Gamma must already be residuated
% F2 is always a free variable which is the tail of F1 (as a failure cont)
prove(top, _, top, _, _, success).
prove(top, Gamma, top, FQ, N, J) :-  % fail from success for more solns
	prove(bot, Gamma, top, FQ, N, J).
prove(top, Gamma, and(G, S), FQ, N, J) :-
	prove(G, Gamma, S, FQ, N, J).
prove(and(G1, G2), Gamma, S, FQ, N, J) :-
	prove(G1, Gamma, and(G2, S), FQ, N, J).
prove(bot, _, _, bot \ bot, _, J) :- !, J = failure.  % commit to avoid next clause
prove(bot, Gamma, _, or(and(G2, S), F1) \ F2, N, J) :-
	prove(G2, Gamma, S, F1 \ F2, N, J).
prove(or(G1, G2), Gamma, S, F1 \ or(and(G2, S), F2), N, J) :-
	prove(G1, Gamma, S, F1 \ F2, N, J).
prove(equal(T1, T2), Gamma, S, FQ, N, J) :-
	unify(T1, T2, Theta) ->
	( apply_prop(S, Theta, STheta),
	  prove(top, Gamma, STheta, FQ, N, J) )
      ;
	prove(bot, Gamma, S, FQ, N, J).
prove(exists(X, G), Gamma, S, FQ, N, J) :-
	apply_prop(G, [for(var(N),X)], G1),
	N1 is N+1,
	prove(G1, Gamma, S, FQ, N1, J).
prove(app(Pred, Ts), Gamma, S, FQ, N, J) :-
	length(Ts, Arity),
	memberchk(prog(Pred/Arity, implies(G, app(Pred, Args))), Gamma),
	zip_subst(Ts, Args, Theta),
	apply_prop(G, Theta, GTheta),
	% push GTheta onto queue of failure continuations for fairness
	prove(or(bot,GTheta), Gamma, S, FQ, N, J).

% N = next free variable
% Gamma |- G, N is next free variable, J = success of failure
prove(G, Gamma, N, J) :- prove(G, Gamma, top, F \ F, N, J).

% zip_subst([T1,...,Tn], [X1,...,Xn], [T1/X1,...,Tn/Xn])
zip_subst([], [], []).
zip_subst([T|Ts], [var(X)|Xs], [for(T, X)| Theta]) :-
	zip_subst(Ts, Xs, Theta).

% transform program to residuated form
% resid_prog([Pred1/Arity1,...], [implies(G1, app(Pred1, Args1)), ...]).
% normal program does not quantify over argument variables
resid_prog([Pred/Arity|Preds],
	   [prog(Pred/Arity, implies(G, app(Pred, Args)))|Gamma]) :-
	reify(Pred/Arity, D),
	arg_vars(0, Arity, Args),
	resid(D, app(Pred, Args), G),
	resid_prog(Preds, Gamma).
resid_prog([], []).

% resid(D, P, G) if D |- P > G
resid(forall(bd(X), D), P, exists(bd(X), G)) :-
	resid(D, P, G).
resid(and(D1, D2), P, or(G1, G2)) :-
	resid(D1, P, G1),
	resid(D2, P, G2).
resid(top, _, bot).
resid(implies(G2, D1), P, and(G1, G2)) :-
	resid(D1, P, G1).
resid(app(Pred, Ss), P, equal(app(Pred, Ss), P)).

% arg_vars(N,Arity) = [var(arg(N)),...,var(arg(Arity-1))]
arg_vars(Arity, Arity, []).
arg_vars(N, Arity, [var(arg(N))|Args]) :-
	N < Arity,
	N1 is N+1,
	arg_vars(N1, Arity, Args).

% apply_prop(A, Theta, A Theta)
apply_prop(top, _, top).
apply_prop(and(A, B), Theta, and(ATheta, BTheta)) :-
	apply_prop(A, Theta, ATheta),
	apply_prop(B, Theta, BTheta).
apply_prop(bot, _, bot).
apply_prop(or(A, B),  Theta, or(ATheta, BTheta)) :-
	apply_prop(A, Theta, ATheta),
	apply_prop(B, Theta, BTheta).
apply_prop(implies(A, B), Theta, implies(ATheta, BTheta)) :-
	apply_prop(A, Theta, ATheta),
	apply_prop(B, Theta, BTheta).
apply_prop(equal(T, S), Theta, equal(TTheta, STheta)) :-
	apply(T, Theta, TTheta),
	apply(S, Theta, STheta).
apply_prop(forall(bd(X), A), Theta, forall(bd(X), ATheta)) :-
	% bd(X) notin dom(Theta) or cod(Theta)!
	apply_prop(A, Theta, ATheta).
apply_prop(exists(bd(X), A), Theta, exists(bd(X), ATheta)) :-
	% bd(X) notin dom(Theta) or cod(Theta)!
	apply_prop(A, Theta, ATheta).
apply_prop(app(Pred, Ts), Theta, app(Pred, TsTheta)) :-
	applys(Ts, Theta, TsTheta).