As a step towards implementing an experimental type inferencing or type checking system I have built a prolog interpreter in Church. The interpreter is based on the example in Peter Norvig’s book, “Paradigms of Artificial Intelligence Programming”.
As a first step I wrote the grammar for parsing prolog programs. Here is a sample ‘parent’ program describing parent and grandparent relationships between Debian derivatives:
parent(ubuntu,kubuntu).
parent(ubuntu,edubuntu).
parent(debian, ubuntu).
grandparent(X,Z) :- parent(X,Y), parent(Y,Z).
and here is the OMeta grammar for parsing prolog programs:
ometa prolog <: ometa {
comment = "/*" (~cnewline anything)* cnewline -> << '_comment >>,
ws = $ | $ ,
wsnl = ws | cnewline,
prolog-top-levels = (comment | prolog-rule)*,
prolog-rule = wsnl* prolog-clause:rhead ws* (":-" ws* prolog-or:body -> << body >>)* ws* $. wsnl* -> <<`[rule ,rhead ,body]>>,
prolog-or = listof("prolog-impl", ";"):e wsnl* -> << `[or ,e] >>,
prolog-impl = wsnl* prolog-clause:a wsnl* "->" wsnl* prolog-or:b wsnl* -> << `[implies ,a ,b] >> | prolog-and,
prolog-and = wsnl* listof("prolog-expr", ","):e wsnl* -> << `[and ,e] >>,
prolog-clause = wsnl* prolog-name:name wsnl* prolog-arg-list:args wsnl* -> <<`[,name | ,args]>>,
prolog-arg-list = $( listof("prolog-expr", ","):args wsnl* $) wsnl* -> << args >>,
prolog-expr = wsnl* (
$[ wsnl* $] wsnl* -> << `[]>> |
$[ wsnl* listof("prolog-expr", ","):list-head ws* ($| wsnl* prolog-expr)*:list-tail wsnl* $] wsnl* -> << (append! list-head (if list-tail (first list-tail) nil)) >> |
$( wsnl* prolog-or:e wsnl* $) wsnl* -> << e >> |
prolog-clause:c wsnl* -> << c >> |
prolog-number |
prolog-variable:v wsnl* -> << v >>),
prolog-number = "-"*:sign digit+:d -> << (convert-number sign d)>>,
prolog-variable = (letter | digit | $_)+:l -> << (intern (coerce l 'string)) >>,
prolog-name = (letter | digit | $_)+:l -> << (intern (coerce l 'string)) >> }
The core of prolog lies in the unification and backtracking algorithms.
Unification will try to match its two inputs or else bind a variable to the corresponding value:
unify x y bindings
cond
(eq? bindings prolog-fail) prolog-fail
(eq? x y) bindings
(eq? x '_) bindings
(eq? y '_) bindings
(variable-symbol? x) (unify-variable x y bindings)
(variable-symbol? y) (unify-variable y x bindings)
(and (cons? x) (cons? y)) (unify (rest x) (rest y) (unify (first x) (first y) bindings))
true prolog-fail
unify-variable var x bindings
cond
(get-binding var bindings) (unify (lookup var bindings) x bindings)
(and (variable-symbol? x) (get-binding x bindings)) (unify var (lookup x bindings) bindings)
(and occurs-check? (occurs-check var x bindings)) prolog-fail
true (extend-bindings var x bindings)
Backtracking is achieved by allowing each clause to provide multiple solutions and trying all of these possibilities:
prove-all pi:prolog-interpreter goals bindings
cond
(eq? bindings prolog-fail) nil
(null? goals) (list bindings)
true
mapcan (fn goal1-solution
prove-all pi (rest goals) goal1-solution
) (prove pi (first goals) bindings)
As a test I used this map coloring program from a prolog tutorial:
member(X,[X|_]).
member(X,[_|List]) :- member(X,List).
adjacent(X,Y,Map) :- member([X,Y],Map) ; member([Y,X],Map).
find_regions([],R,R).
find_regions([[X,Y]|S], R,A) :-
(member(X,R) ->
(member(Y,R) -> find_regions(S,R,A) ; find_regions(S,[Y|R],A)) ;
(member(Y,R) -> find_regions(S,[X|R],A) ; find_regions(S,[X,Y|R],A) )).
color(Map,Colors,Coloring) :-
find_regions(Map,[],Regions),
color_all(Regions,Colors,Coloring),
not(conflict(Map,Coloring)).
color_all([R|Rs],Colors,[[R,C]|A]) :-
member(C,Colors),
color_all(Rs,Colors,A).
color_all([],_,[]).
conflict(Map,Coloring) :- member([R1,C],Coloring),
member([R2,C],Coloring),
adjacent(R1,R2,Map).
map1([[1,2],[1,3],[1,4],[1,5],[2,3],[2,4],[3,4],[4,5]]).
which yields the following colourings:
"query"
[[map1 M] [color M [red green blue yellow] Coloring]]
M = [[1 2] [1 3] [1 4] [1 5] [2 3] [2 4] [3 4] [4 5]]
Coloring = [[5 red] [4 green] [3 red] [1 blue] [2 yellow]]
;
M = [[1 2] [1 3] [1 4] [1 5] [2 3] [2 4] [3 4] [4 5]]
Coloring = [[5 red] [4 green] [3 red] [1 yellow] [2 blue]]
...
You can browse the source files for the prolog interpreter here.