├── README.md
└── lisprolog.pl
/README.md:
--------------------------------------------------------------------------------
1 |
2 | # Interpreter for a simple Lisp, written in Prolog
3 |
4 | Some online books show how to implement simple "Prolog" engines in
5 | Lisp. These engines typically assume a representation of Prolog
6 | programs that is convenient from a Lisp perspective, and can't even
7 | parse a single proper Prolog term. Instead, they require you to
8 | manually translate Prolog programs to Lisp forms that are no longer
9 | valid Prolog syntax. With this approach, implementing a simple "Lisp"
10 | in Prolog is even easier ("Lisp in Prolog in zero lines"): Manually
11 | translate each Lisp function to a Prolog predicate with one additional
12 | argument to hold the original function's return value. Done. This is
13 | possible since a function is a special case of a relation, and
14 | functional programming is a restricted form of logic programming.
15 |
16 | Here is a bit beyond that: [**`lisprolog.pl`**](lisprolog.pl)
17 |
18 | These 165 lines of Prolog code give you an interpreter for a simple
19 | Lisp, *including* a parser to let you write Lisp code in its
20 | natural form.
21 |
22 | Internally, Prolog [**Definite Clause
23 | Grammars**](https://www.metalevel.at/prolog/dcg) are used for parsing
24 | Lisp code, and
25 | [semicontext notation](https://www.metalevel.at/prolog/dcg#semicontext)
26 | is used to implicitly thread through certain arguments. This
27 | Prolog feature is very similar to Haskell's monads.
28 |
29 | Read [**The Power of Prolog**](https://www.metalevel.at/prolog) for
30 | more information about Prolog.
31 |
32 |
33 | Sample queries, using Scryer Prolog:
34 |
35 |
36 | Append:
37 |
38 |
39 | ?- run(" \
40 | \
41 | (defun append (x y) \
42 | (if x \
43 | (cons (car x) (append (cdr x) y)) \
44 | y)) \
45 | \
46 | (append '(a b) '(3 4 5)) \
47 | \
48 | ", Vs).
49 | Vs = [append,[a,b,3,4,5]].
50 |
51 |
52 |
53 | Fibonacci, naive version:
54 |
55 |
56 | ?- time(run(" \
57 | \
58 | (defun fib (n) \
59 | (if (= 0 n) \
60 | 0 \
61 | (if (= 1 n) \
62 | 1 \
63 | (+ (fib (- n 1)) (fib (- n 2)))))) \
64 | (fib 24) \
65 | \
66 | ", Vs)).
67 | % CPU time: 6.414s
68 | Vs = [fib,46368].
69 |
70 |
71 |
72 | Fibonacci, accumulating version:
73 |
74 |
75 | ?- time(run(" \
76 | \
77 | (defun fib (n) \
78 | (if (= 0 n) 0 (fib1 0 1 1 n))) \
79 | \
80 | (defun fib1 (f1 f2 i to) \
81 | (if (= i to) \
82 | f2 \
83 | (fib1 f2 (+ f1 f2) (+ i 1) to))) \
84 | \
85 | (fib 250) \
86 | \
87 | ", Vs)).
88 |
89 | % CPU time: 0.020s
90 | Vs = [fib,fib1,7896325826131730509282738943634332893686268675876375].
91 |
92 |
93 |
94 | Fibonacci, iterative version:
95 |
96 |
97 | ?- time(run(" \
98 | \
99 | (defun fib (n) \
100 | (setq f (cons 0 1)) \
101 | (setq i 0) \
102 | (while (< i n) \
103 | (setq f (cons (cdr f) (+ (car f) (cdr f)))) \
104 | (setq i (+ i 1))) \
105 | (car f)) \
106 | \
107 | (fib 350) \
108 | \
109 | ", Vs)).
110 |
111 | % CPU time: 0.021s
112 | Vs = [fib,6254449428820551641549772190170184190608177514674331726439961915653414425].
113 |
114 |
115 |
116 | Higher-order programming and eval:
117 |
118 |
119 | ?- run(" \
120 | \
121 | (defun map (f xs) \
122 | (if xs \
123 | (cons (eval (list f (car xs))) (map f (cdr xs))) \
124 | ())) \
125 | \
126 | (defun plus1 (x) (+ 1 x)) \
127 | \
128 | (map 'plus1 '(1 2 3)) \
129 | \
130 | ", Vs).
131 | Vs = [map,plus1,[2,3,4]].
132 |
133 |
134 | More information about this interpreter is available at:
135 |
136 | [**https://www.metalevel.at/lisprolog/**](https://www.metalevel.at/lisprolog/)
137 |
--------------------------------------------------------------------------------
/lisprolog.pl:
--------------------------------------------------------------------------------
1 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2 | Lisprolog -- Interpreter for a simple Lisp. Written in Prolog.
3 | Written Nov. 26th, 2006 by Markus Triska (triska@metalevel.at).
4 | Public domain code. https://www.metalevel.at/lisprolog/
5 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
6 |
7 | :- use_module(library(charsio)).
8 | :- use_module(library(dcgs)).
9 | :- use_module(library(lists)).
10 | :- use_module(library(assoc)).
11 |
12 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
13 | Parsing. See https://www.metalevel.at/prolog/dcg for more.
14 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
15 |
16 | parsing(String, Exprs) :- phrase(expressions(Exprs), String).
17 |
18 | expressions([E|Es]) -->
19 | ws, expression(E), ws,
20 | !, % single solution: longest input match
21 | expressions(Es).
22 | expressions([]) --> [].
23 |
24 | ws --> [W], { char_type(W, whitespace) }, ws.
25 | ws --> [].
26 |
27 | % A number N is represented as n(N), a symbol S as s(S).
28 |
29 | expression(s(A)) --> symbol(Cs), { atom_chars(A, Cs) }.
30 | expression(n(N)) --> number(Cs), { number_chars(N, Cs) }.
31 | expression(List) --> "(", expressions(List), ")".
32 | expression([s(quote),Q]) --> "'", expression(Q).
33 |
34 | number([D|Ds]) --> digit(D), number(Ds).
35 | number([D]) --> digit(D).
36 |
37 | digit(D) --> [D], { char_type(D, decimal_digit) }.
38 |
39 | symbol([A|As]) -->
40 | [A],
41 | { memberchk(A, "+/-*><=") ; char_type(A, alpha) },
42 | symbolr(As).
43 |
44 | symbolr([A|As]) -->
45 | [A],
46 | { memberchk(A, "+/-*><=") ; char_type(A, alnum) },
47 | symbolr(As).
48 | symbolr([]) --> [].
49 |
50 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
51 | Interpretation
52 | --------------
53 |
54 | Declaratively, execution of a Lisp form is a relation between the
55 | (function and variable) binding environment before its execution
56 | and the environment after its execution. A Lisp program is a
57 | sequence of Lisp forms, and its result is the sequence of their
58 | results. The environment is represented as a pair of association
59 | lists Fs-Vs, associating function names with argument names and
60 | bodies, and variables with values. DCGs are used to implicitly
61 | thread the environment state through.
62 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
63 |
64 | run(Program, Values) :-
65 | parsing(Program, Forms0),
66 | empty_assoc(E),
67 | compile_all(Forms0, Forms),
68 | phrase(eval_all(Forms, Values0), [E-E], _),
69 | maplist(unfunc, Values0, Values).
70 |
71 | unfunc(s(S), S).
72 | unfunc(t, t).
73 | unfunc(n(N), N).
74 | unfunc([], []).
75 | unfunc([Q0|Qs0], [Q|Qs]) :- unfunc(Q0, Q), unfunc(Qs0, Qs).
76 |
77 | fold([], _, V, n(V)).
78 | fold([n(F)|Fs], Op, V0, V) :- E =.. [Op,V0,F], V1 is E, fold(Fs, Op, V1, V).
79 |
80 | compile_all(Fs0, Fs) :- maplist(compile, Fs0, Fs).
81 |
82 | /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
83 | compile/2 marks (with "user/1") calls of user-defined functions.
84 | This eliminates an otherwise defaulty representation of function
85 | calls and thus allows for first argument indexing in eval//3.
86 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
87 |
88 | compile(F0, F) :-
89 | ( F0 = n(_) -> F = F0
90 | ; F0 = s(t) -> F = t
91 | ; F0 = s(nil) -> F = []
92 | ; F0 = s(_) -> F = F0
93 | ; F0 = [] -> F = []
94 | ; F0 = [s(quote),Arg] -> F = [quote,Arg]
95 | ; F0 = [s(setq),s(Var),Val0] -> compile(Val0, Val), F = [setq,Var,Val]
96 | ; F0 = [s(Op)|Args0],
97 | memberchk(Op, [+,-,*,equal,if,>,<,=,progn,eval,list,car,cons,
98 | cdr,while,not]) ->
99 | compile_all(Args0, Args),
100 | F = [Op|Args]
101 | ; F0 = [s(defun),s(Name),Args0|Body0] ->
102 | compile_all(Body0, Body),
103 | maplist(arg(1), Args0, Args),
104 | F = [defun,Name,Args|Body]
105 | ; F0 = [s(Op)|Args0] -> compile_all(Args0, Args), F = [user(Op)|Args]
106 | ).
107 |
108 | eval_all([], []) --> [].
109 | eval_all([A|As], [B|Bs]) --> eval(A, B), eval_all(As, Bs).
110 |
111 | eval(n(N), n(N)) --> [].
112 | eval(t, t) --> [].
113 | eval([], []) --> [].
114 | eval(s(A), V), [Fs-Vs] --> [Fs-Vs], { get_assoc(A, Vs, V) }.
115 | eval([L|Ls], Value) --> eval(L, Ls, Value).
116 |
117 | eval(quote, [Q], Q) --> [].
118 | eval(+, As0, V) --> eval_all(As0, As), { fold(As, +, 0, V) }.
119 | eval(-, As0, V) --> eval_all(As0, [n(V0)|Vs0]), { fold(Vs0, -, V0, V) }.
120 | eval(*, As0, V) --> eval_all(As0, Vs), { fold(Vs, *, 1, V) }.
121 | eval(car, [A], C) --> eval(A, V), { V == [] -> C = [] ; V = [C|_] }.
122 | eval(cdr, [A], C) --> eval(A, V), { V == [] -> C = [] ; V = [_|C] }.
123 | eval(list, Ls0, Ls) --> eval_all(Ls0, Ls).
124 | eval(not, [A], V) --> eval(A, V0), goal_truth(V0=[], V).
125 | eval(>, [A,B], V) --> eval(A, n(V1)), eval(B, n(V2)), goal_truth(V1>V2, V).
126 | eval(<, [A,B], V) --> eval(>, [B,A], V).
127 | eval(=, [A,B], V) --> eval(A, n(V1)), eval(B, n(V2)), goal_truth(V1=:=V2, V).
128 | eval(progn, Ps, V) --> eval_all(Ps, Vs), { last(Vs, V) }.
129 | eval(eval, [A], V) --> eval(A, F0), { compile(F0, F1) }, eval(F1, V).
130 | eval(equal, [A,B], V) --> eval(A, V1), eval(B, V2), goal_truth(V1=V2, V).
131 | eval(cons, [A,B], [V0|V1]) --> eval(A, V0), eval(B, V1).
132 | eval(while, [Cond|Bs], []) -->
133 | ( eval(Cond, []) -> []
134 | ; eval_all(Bs, _),
135 | eval(while, [Cond|Bs], _)
136 | ).
137 | eval(defun, [F,As|Body], s(F)), [Fs-Vs0] -->
138 | [Fs0-Vs0],
139 | { put_assoc(F, Fs0, As-Body, Fs) }.
140 | eval(user(F), As0, V), [Fs-Vs] -->
141 | eval_all(As0, As1),
142 | [Fs-Vs],
143 | { empty_assoc(E),
144 | get_assoc(F, Fs, As-Body),
145 | bind_arguments(As, As1, E, Bindings),
146 | phrase(eval_all(Body, Results), [Fs-Bindings], _),
147 | last(Results, V) }.
148 | eval(setq, [Var,V0], V), [Fs0-Vs] -->
149 | eval(V0, V),
150 | [Fs0-Vs0],
151 | { put_assoc(Var, Vs0, V, Vs) }.
152 | eval(if, [Cond,Then|Else], Value) -->
153 | ( eval(Cond, []) -> eval_all(Else, Values), { last(Values, Value) }
154 | ; eval(Then, Value)
155 | ).
156 |
157 | goal_truth(Goal, T) --> { Goal -> T = t ; T = [] }.
158 |
159 | bind_arguments([], [], Bs, Bs).
160 | bind_arguments([A|As], [V|Vs], Bs0, Bs) :-
161 | put_assoc(A, Bs0, V, Bs1),
162 | bind_arguments(As, Vs, Bs1, Bs).
163 |
164 | last(Ls, L) :- reverse(Ls, [L|_]).
165 |
--------------------------------------------------------------------------------