Guide to Prolog Programming

© Roman Barták, 1998

Home
Advanced Techniques
Meta-programming

Previous | Contents | Next

Meta-Interpreters

Because it is possible to directly access program code in Prolog, it is easy to write interpreter of Prolog in Prolog. Such interpreter is called a meta-interpreter. Meta-interpreters are usually used to add some extra features to Prolog, e.g., to change build-in negation as failure to constructive negation.

The simplest Prolog meta-interpreter is a following program:

solve(Goal):-call(Goal).

However, there is not advantage of using such meta-intepreter as it immediately calls Prolog interpreter. Much more popular is "vanilla" meta-interpreter that uses Prolog's build-in unification but enables access to search engine which can be easily modified (e.g., it is possible to change the order of goals' execution)

solve(true).
solve((A,B)):-
   solve(A),solve(B).
solve(A):-
   clause(A,B),solve(B).

Note, that vanilla meta-interpreter uses build-in predicate clause(H,B) which finds a clause in Prolog program with head that unifies with H and body B (if there is no body, then Body=true).

The modified vanilla meta-interpreter can be used to compute "proof" of the computation:

solve(true,fact).
solve((A,B),(ProofA,ProofB)):-
   solve(A,ProofA),solve(B,ProofB).
solve(A,A-ProofB):-
   clause(A,B),solve(B,ProofB).

It is also possible to write a meta-interpreter that uses list of goals instead of traditional conjunction of goals. In some cases, this could be more natural as one does not need to traverse the structure of goal each time a primitive goal is being found.

solve([]).
solve([A|T]):-
   clause(A,B),
   add_to_list(B,T,NT),
   solve(NT).

We modify the above meta-interpreter to get a meta-interpreter of guarded Prolog. Each clause in guarded Prolog contains a test (Prolog goal) called guard which has to be satisfied before using the clause. Because traditional Prolog has no guards we can write meta-interpreter that extends behaviour of Prolog to handle guards.

solve([]).
solve([A|T]):-
   clause(A,B),
   distribute(B,GoalB,Guard),
   call(Guard),
   append(GoalB,T,NT),
   solve(NT).

Let the following clause be the clause with guards, where guards is indicated by g:

a(X):-g(X>0),b(X).

Then , the procedure distribute that finds guards and regual goals in the body of clause can be programmed in a following way (using double accumulator):

distribute(B,ListGoal,Guard):-
   distr(B,[],ListGoal,true,Guard).
distr((A,B),OldList,NewList,OldG,NewG):-          % conjunction
   distr(B,OldList,SubList,OldG,SubG),
   distr(A,SubList,NewList,SubG,NewG).
distr(g(G),GoalList,GoalList,OldG,(G,OldG)).      % guard
distr(G,GoalList,[G|GoalList],Guard,Guard):-      % regular primitive goal
   G\=(_,_),G\=g(_).

Because it is possible to directly access program code in Prolog, it is easy to write interpreter of Prolog in Prolog. Such interpreter is called a meta-interpreter. Meta-interpreters are usually used to add some extra features to Prolog, e.g., to change build-in negation as failure to constructive negation.


Designed and maintained by Roman Barták

Previous | Contents | Next