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

% 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
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, D), Gamma), % succeeds only once
	arg_vars(0, Ts, Args),
	resid(D, app(Pred, Args), G),
	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).

% 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).

% 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) = [var(arg(1)),...,var(arg(N))]
arg_vars(_, [], []).
arg_vars(N, [_|Ts], [var(arg(N))|Args]) :-
	N1 is N+1,
	arg_vars(N1, Ts, 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).