Ken Tilton <[EMAIL PROTECTED]> writes:
> I think all-rules-all-the-time Prolog is the poster boy for paradigm
> slavery. (I did try for a famous two months to use Prolog as a
> general-purpose programming language.)
Don't expect to learn Prolog properly in so little time. To your
previous question whether the ~180 lines of Lisp code in some online
book constitute an "industrial strength" Prolog: only if the following
~180 lines of Prolog code implement an "industrial strength" Lisp.
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).
They give you a simple Lisp and, in contrast to some online books
claiming to give you "Prolog" (an ISO-standardised language) and then
failing to even parse a single proper Prolog term, also let you write
it in its natural form. Example queries tested with SWI Prolog:
"append":
?- run("(defun append (x y) (if (equal x '()) y (cons (car x) (append (cdr
x) y)))) (append '(1 2 3) '(4 5))", V).
==> V = [append, [number(1), number(2), number(3), number(4), number(5)]] ;
Fibonacci, naive version:
?- time(run("(defun fib (n) (if (= 0 n) 0 (if (= 1 n) 1 (+ (fib (- n 1))
(fib (- n 2)))))) (fib 24)", V)).
==> V = [fib, 46368] ;
9,567,271 inferences, 3.42 CPU in 3.50 seconds (98% CPU, 2797448 Lips)
Different version:
?- time(run("(defun fib (n) (if (= 0 n) 0 (fib1 0 1 1 n))) (defun fib1 (f1
f2 i to) (if (= i to) f2 (fib1 f2 (+ f1 f2) (+ i 1) to))) (fib 100)", V)).
==> 16,275 inferences, 0.01 CPU in 0.01 seconds (163% CPU, 1627500 Lips)
V = [fib, fib1, 354224848179261915075] ;
Using a while loop:
?- time((run("(defun fib (n) (setq f (cons 0 1)) (setq i 0) (while (< i n)
(setq f (cons (cdr f) (+ (car f) (cdr f)))) (setq i (+ i 1))) (car f)) (fib
200)", V))).
==> 20,509 inferences, 0.02 CPU in 0.01 seconds (239% CPU, 1025450 Lips)
V = [fib, 280571172992510140037611932413038677189525] ;
Showing "eval" and "map":
?- run("(defun map (f xs) (if (equal xs '()) '() (cons (eval (list f (car
xs))) (map f (cdr xs))))) (defun plus1 (x) (+ 1 x)) (map 'plus1 '(1 2 3))", Vs).
==> Vs = [map, plus1, [2, 3, 4]] ;
Prolog's analogon to Lisp's macros is term_expansion/2 by the way.
All the best!
Markus Triska
--
http://mail.python.org/mailman/listinfo/python-list
