1 /*******************************************************************
3 * A Lisp interpreter
, written
in Prolog
5 * (lisp_interpreter
.pl
)
9 * This program is a small interpreter
for Lisp
. It was written
10 * in LPA Prolog v3
.6
, running under Windows
. It should be fairly
11 * easy to convert it to other Prologs
.
13 * It supports real Lisp syntax
, excessive brackets
and all
. You don
't
14 * need to terminate input with a full stop. It also understands
15 * 'x
for (quote x
) and #'func for (function func)
17 * Variables are lexically scoped
, except where
defined as special
.
19 * read_words code from
"The Craft of Prolog", R
.A
.O
'Keefe
20 * lisp evaluator from "Lisp" (3rd ed), Winston & Horn.
22 *******************************************************************/
31 % :- initialization lisp.
38 write('Welcome to Pro
-Lisp
!'),nl,
39 write('This is a miniscule Lisp interpreter
, written
in Prolog
'),nl,
45 read_eval_print(Result),
54 retractall(lambda(_, _)).
57 read_eval_print(Result):- % dodgy use of cuts to force a single evaluation
58 read_and_parse(Expression),
59 eval(Expression, Result),
60 writeExpression(Result),
65 % basic EVAL statements for built-in procedures
67 eval(Expression, Result):-
69 eval(Expression, Bindings, Result).
72 macro_expand([],[]):-!.
73 macro_expand([#, '''', X|Xs], [[function, MX]|MXs]):-
76 macro_expand(Xs, MXs).
77 macro_expand(['''', X|Xs], [[quote, MX]|MXs]):-
80 macro_expand(Xs, MXs).
81 macro_expand([X|Xs], [MX|MXs]):-
84 macro_expand(Xs, MXs).
90 eval(quit, _, quit):-!.
94 eval([quote, X], _, X):-!.
95 eval([quit], _, quit):-!.
96 eval([defvar, Name], _, Name):-
98 retract(bindings(GlobalBindings)),
99 assert(bindings([binding(Name, [])|GlobalBindings])),
101 eval([setq, Name, Value], Bindings, EvalValue):-
103 bindings(GlobalBindings),
104 append(Pre, [binding(Name, _)|Post], GlobalBindings),
105 eval(Value, Bindings, EvalValue),
106 retract(bindings(GlobalBindings)),
107 append(Pre, [binding(Name, EvalValue)|Post], GlobalBindings1),
108 assert(bindings(GlobalBindings1)),
110 eval([defun, Name, FormalParms, Body], _, Name):-
112 assert(lambda(Name, [lambda, FormalParms, Body])),
114 eval([apply|Arguments], Bindings, Result):-
116 evalL(Arguments, Bindings, [Function, ActualParams]),
117 apply(Function, ActualParams, Result),
119 eval([function, [lambda, FormalParams, Body]], Bindings,
120 [closure, FormalParams, Body, Bindings]):-!.
121 eval([Procedure|Arguments], Bindings, Result):-
122 evalL(Arguments, Bindings, EvalArguments),
123 apply(Procedure, EvalArguments, Result),
128 eval(X, Bindings, Val):-
130 member(binding(X, Val), Bindings)
131 ; (bindings(GlobalBindings),
132 member(binding(X, Val), GlobalBindings)),
135 write('ERROR
! Cannot find a binding
for `'),
142 evalL([H|T], Bindings, [EvalH|EvalT]):-
143 eval(H, Bindings, EvalH),
144 evalL(T, Bindings, EvalT),
148 apply(car, [[Result|_]], Result):-!.
149 apply(cdr, [[_|Result]], Result):-!.
150 apply(list, Args, Args):-!.
151 apply(cons, [Arg1, Arg2], [Arg1|Arg2]):-!.
152 apply(eq, [Arg1, Arg2], Result):-
153 (Arg1 = Arg2 -> Result = Arg1
156 apply(if, [Test, Success, Failure], Result):-
157 eval(Test, TestResult),
158 eval(Success, EvalSuccess),
159 eval(Failure, EvalFailure),
160 (TestResult = [] -> Result = EvalFailure
161 ; Result = EvalSuccess),
163 apply([lambda, FormalParams, Body], ActualParams, Result):-
165 bind_variables(FormalParams, ActualParams, Bindings),
166 eval(Body, Bindings, Result),
168 apply([closure, FormalParams, Body, Bindings0], ActualParams, Result):-
170 bind_variables(FormalParams, ActualParams, Bindings0, Bindings),
171 eval(Body, Bindings, Result),
173 apply(ProcedureName, Args, Result):-
174 lambda(ProcedureName, LambdaExpression),
175 apply(LambdaExpression, Args, Result),
178 write('ERROR
! Cannot find a procedure description
for `'),
185 bind_variables(Formal, Actual, Bindings):-
186 bind_variables(Formal, Actual, [], Bindings).
188 bind_variables([], [], Bindings, Bindings).
189 bind_variables([FormalParam|FormalParams], [ActualParam|ActualParams],
190 Bindings0, Bindings):-
191 bind_variables(FormalParams, ActualParams,
192 [binding(FormalParam, ActualParam)|Bindings0], Bindings).
197 % read and parse a line of Lisp
199 read_and_parse(Expression):-
201 ( sexpr(Expression, TokenL, [])
203 ( write('ERROR
! Could
not parse
`'),
212 % read a line of supposed Lisp code
216 read_words(C, Words).
221 read_words(C, Words):-
225 read_words(C, [Word|Words]):-
230 read_words(C, [Word|Words]):-
233 read_rest_of_word(Chars, LeftOver),
234 name(UCWord, [C|Chars]),
235 ( atom(UCWord) -> lwrupr(Word, UCWord)
238 read_words(LeftOver, Words).
241 read_rest_of_word(Chars, LeftOver):-
243 read_rest_of_word(C, Chars, LeftOver).
246 read_rest_of_word(C, [], C):-
249 read_rest_of_word(C, [C|Chars], LeftOver):-
252 read_rest_of_word(Chars, LeftOver).
285 \+ punctuation(Char).
288 % Grammar rules for parsing Lisp s-expressions.
289 % Given a list of tokens, lisplist does all the nesting of lists
292 sexpr([function, Expression]) --> [#, ''''], !, sexpr(Expression).
293 sexpr([quote, Expression]) --> [''''], !, sexpr(Expression).
294 sexpr(Xs) --> ['('], lisplist(Xs), !.
295 sexpr(X) --> [X], {atomic(X), X \= '.'}, !.
298 lisplist([]) --> [')'], !.
299 lisplist([X|Xs]) --> sexpr(X), lisplist(Xs), !.
300 lisplist([X|Y]) --> sexpr(X), ['.'], sexpr(Y), [')'], !.
304 % writeExpression/1 displays a lisp expression
306 writeExpression(quit):-
308 write('Terminating Pro-Lisp'),nl.
309 writeExpression(Expression):-
310 sexpr(Expression, TokenL, []),
317 writeTokenL(['(', ')'|TokenL]):-
321 writeTokenL([Token|TokenL]):-
324 lwrupr(Token, UCToken),
328 writeTokenL([Token|TokenL]):-