Re: Prologs combined with other tools

"Kobayashi" <kubilayisik@xxxxxxxxx> wrote:

Hmm... I have searched the comp.lang.prolog and comp.lang.lisp and
have found that there have been many attempts to implement a Prolog
interpreter in Lisp.

Attempts, yes. Mostly these toy "Prolog" implementations can't even
parse a single proper Prolog term though.

And is there a Lisp interpreter (or compiler! ;^D) implemented in
Prolog?

http://stud4.tuwien.ac.at/~e0225855/lisprolog/lisprolog.html

The code follows. As you see, it indeed contains a compiler, and it's
straight-forward to change its output to a more low-level form, like
byte-code or integer-code, for use in a stack-based virtual machine.


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Parsing
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

ws --> [W], { W =< 0' }, ws.
ws --> [].

open_paren --> ws, "(", ws.
close_paren --> ws, ")", ws.

parse(String, Expr) :- phrase(expressions(Expr), String).

list(Es) --> open_paren, expressions(Es), close_paren.

expressions([E|Es]) -->
expression(E), ws,
!, % single solution: longest input match
expressions(Es).
expressions([]) --> [].

expression(symbol(A)) --> symbol(A0), { name(A, A0) }.
expression(number(N)) --> number(N0), { name(N, N0) }.
expression(List) --> list(List).
expression([symbol(quote),Q]) --> "'", expression(Q).

number([D|Ds]) --> digit(D), number(Ds).
number([D]) --> digit(D).

digit(D) --> [D], {0'0 =< D, D =< 0'9 }.

symbol([A|As]) -->
[A],
{ memberchk(A, "+/-*><=abcdefghijklmnopqrstuvwxyz") },
symbolr(As).

symbolr([A|As]) -->
[A],
{ memberchk(A, "+/-*><=abcdefghijklmnopqrstuvwxyz0123456789") },
symbolr(As).
symbolr([]) --> [].

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Interpretation
--------------
Declaratively, execution of a Lisp form establishes a relation
between the (function and variable) binding environment before its
execution and the environment after its execution. A Lisp program
is a sequence of Lisp forms, and its result is the sequence of
their results. Initially, the environment is empty.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

run(Program, Values) :-
parse(Program, Forms0),
empty_assoc(E),
compile_all(Forms0, Forms),
eval_all(Forms, E, _, E, _, Values).

fold([], _, V, V).
fold([F|Fs], Op, V0, V) :- E =.. [Op,V0,F], V1 is E, fold(Fs, Op, V1, V).

compile_all(Fs0, Fs) :- maplist(compile, Fs0, Fs).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
compile/2 marks (with "user/1") calls of user-defined functions.
This eliminates an otherwise defaulty representation of function
calls and thus allows for first argument indexing in eval/7.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

compile(F0, F) :-
( F0 = number(_) -> F = F0
; F0 = symbol(t) -> F = t
; F0 = symbol(nil) -> F = nil
; F0 = symbol(_) -> F = F0
; F0 = [] -> F = []
; F0 = [symbol(quote)|Args] -> F = [quote|Args]
; F0 = [symbol(setq),symbol(Var),Val0] ->
compile(Val0, Val),
F = [setq,Var,Val]
; F0 = [symbol(Op)|Args0],
memberchk(Op, [+,-,*,equal,if,>,<,=,progn,eval,list,car,cons,
cdr,while,not]) ->
compile_all(Args0, Args),
F = [Op|Args]
; F0 = [symbol(defun),symbol(Name),Args0|Body0] ->
compile_all(Body0, Body),
maplist(un_symbol, Args0, Args),
F = [defun,Name,Args|Body]
; F0 = [symbol(Op)|Args0] ->
compile_all(Args0, Args),
F = [user(Op)|Args]
).

un_symbol(symbol(S), S).

eval_all([], Fs, Fs, Vs, Vs, []).
eval_all([A|As], Fs0, Fs, Vs0, Vs, [B|Bs]) :-
eval(A, Fs0, Fs1, Vs0, Vs1, B),
eval_all(As, Fs1, Fs, Vs1, Vs, Bs).

eval(number(N), Fs, Fs, Vs, Vs, N).
eval(t, Fs, Fs, Vs, Vs, t).
eval(nil, Fs, Fs, Vs, Vs, nil).
eval(symbol(A), Fs, Fs, Vs, Vs, V) :- get_assoc(A, Vs, V). % variable lookup
eval([L|Ls], Fs0, Fs, Vs0, Vs, Value) :- eval(L, Ls, Fs0, Fs, Vs0, Vs, Value).

eval(+, Args0, Fs0, Fs, Vs0, Vs, Value) :-
eval_all(Args0, Fs0, Fs, Vs0, Vs, Args),
fold(Args, (+), 0, Value).
eval(-, [V0|Rest], Fs0, Fs, Vs0, Vs, Value) :-
eval(V0, Fs0, Fs1, Vs0, Vs1, V1),
eval_all(Rest, Fs1, Fs, Vs1, Vs, Vals),
fold(Vals, (-), V1, Value).
eval(*, Args0, Fs0, Fs, Vs0, Vs, Value) :-
eval_all(Args0, Fs0, Fs, Vs0, Vs, Args),
fold(Args, (*), 1, Value).
eval(equal, [A0,B0], Fs0, Fs, Vs0, Vs, Value) :-
eval(A0, Fs0, Fs1, Vs0, Vs1, A),
eval(B0, Fs1, Fs, Vs1, Vs, B),
( A == B -> Value = t ; Value = nil ).
eval(if, [Cond,Then|Else], Fs0, Fs, Vs0, Vs, Value) :-
eval(Cond, Fs0, Fs1, Vs0, Vs1, V),
( V = nil ->
eval_all(Else, Fs1, Fs, Vs1, Vs, Values),
last(Values, Value)
; eval(Then, Fs1, Fs, Vs1, Vs, Value)
).
eval(not, [Arg], Fs0, Fs, Vs0, Vs, Value) :-
eval(Arg, Fs0, Fs, Vs0, Vs, V),
( V == nil -> Value = t ; Value = nil ).
eval(>, [Arg1,Arg2], Fs0, Fs, Vs0, Vs, Value) :-
eval(Arg1, Fs0, Fs1, Vs0, Vs1, V1),
eval(Arg2, Fs1, Fs, Vs1, Vs, V2),
( V1 > V2 -> Value = t ; Value = nil ).
eval(<, [Arg1,Arg2], Fs0, Fs, Vs0, Vs, Value) :-
eval(Arg1, Fs0, Fs1, Vs0, Vs1, V1),
eval(Arg2, Fs1, Fs, Vs1, Vs, V2),
( V1 < V2 -> Value = t ; Value = nil ).
eval(=, [Arg1,Arg2], Fs0, Fs, Vs0, Vs, Value) :-
eval(Arg1, Fs0, Fs1, Vs0, Vs1, V1),
eval(Arg2, Fs1, Fs, Vs1, Vs, V2),
( V1 =:= V2 -> Value = t ; Value = nil ).
eval(progn, Ps, Fs0, Fs, Vs0, Vs, Value) :-
eval_all(Ps, Fs0, Fs, Vs0, Vs, Values),
last(Values, Value).
eval(eval, [Form0], Fs0, Fs, Vs0, Vs, V) :-
eval(Form0, Fs0, Fs1, Vs0, Vs1, Form1),
compile(Form1, Form2),
eval(Form2, Fs1, Fs, Vs1, Vs, V).
eval(quote, [Q], Fs, Fs, Vs, Vs, Q).
eval(setq, [Var,V0], Fs0, Fs, Vs0, Vs, V) :-
eval(V0, Fs0, Fs, Vs0, Vs1, V),
put_assoc(Var, Vs1, V, Vs).
eval(defun, [Func,Args|Body], Fs0, Fs, Vs, Vs, Func) :-
put_assoc(Func, Fs0, Args-Body, Fs).
eval(list, Ls0, Fs0, Fs, Vs0, Vs, Ls) :-
eval_all(Ls0, Fs0, Fs, Vs0, Vs, Ls).
eval(cons, [Car0,Cdr0], Fs0, Fs, Vs0, Vs, [Car|Cdr]) :-
eval(Car0, Fs0, Fs1, Vs0, Vs1, Car),
eval(Cdr0, Fs1, Fs, Vs1, Vs, Cdr).
eval(car, [Ls0], Fs0, Fs, Vs0, Vs, Car) :-
eval(Ls0, Fs0, Fs, Vs0, Vs, [Car|_]).
eval(cdr, [Ls0], Fs0, Fs, Vs0, Vs, Cdr) :-
eval(Ls0, Fs0, Fs, Vs0, Vs, [_|Cdr]).
eval(while, [Cond|Body], Fs0, Fs, Vs0, Vs, Value) :-
eval(Cond, Fs0, Fs1, Vs0, Vs1, V),
( V == nil -> Value = nil, Fs = Fs0, Vs = Vs0
; eval_all(Body, Fs1, Fs2, Vs1, Vs2, _),
eval(while, [Cond|Body], Fs2, Fs, Vs2, Vs, Value)
).
eval(user(F), Args0, Fs0, Fs, Vs0, Vs, Value) :-
eval_all(Args0, Fs0, Fs, Vs0, Vs, Args),
get_assoc(F, Fs, As-Body),
empty_assoc(E),
bind_arguments(As, Args, E, Bindings),
eval_all(Body, Fs, _, Bindings, _, Results),
last(Results, Value).

bind_arguments([], [], Bs, Bs).
bind_arguments([A|As], [V|Vs], Bs0, Bs) :-
put_assoc(A, Bs0, V, Bs1),
bind_arguments(As, Vs, Bs1, Bs).


All the best,
Markus

--
comp.lang.prolog FAQ: http://www.logic.at/prolog/faq/
.