From 5b949b632cd9db496f8798c67f9a939f41e34d2e Mon Sep 17 00:00:00 2001
From: Neil Smith <neil.git@njae.me.uk>
Date: Sun, 5 Apr 2015 18:03:16 +0100
Subject: [PATCH] Added interpreter file

---
 SIGNED.md           |  70 ++++++++++
 lisp-interpreter.pl | 333 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 403 insertions(+)
 create mode 100644 SIGNED.md
 create mode 100644 lisp-interpreter.pl

diff --git a/SIGNED.md b/SIGNED.md
new file mode 100644
index 0000000..3e3947f
--- /dev/null
+++ b/SIGNED.md
@@ -0,0 +1,70 @@
+##### Signed by https://keybase.io/neilnjae
+```
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v2
+
+iQIcBAABAgAGBQJVIWrYAAoJEJPB2e07PgbqkTcP+wfQUCdTBpwpbll0DKBIxH69
+79/ddLpdKLLPCMVzphun3p7XqfxK0haCx2wwhWsquv3dywPO0wpCT32vm2QHb0FM
+Di+aUbklJa54LOGg0ljeJ5MCB6OmL1E5tTIH+m/q0bfkdSpWKLglX3SfZskBgsxl
+/3D4OE0bmDoLPQIM+EtOW6kogD8i+0pWpUWoamR08iSpBb6PdlbdbAah2ocAeoS9
+pa8DB7g2412RS2nsxWfhD64hhNN/HaHWo/O/gO+FJOphqD/g++eUGxK3mB8W3NAM
+KOtenoLa89VhDxZWhgG+/RwW3iw2EIl4pn1QbIIjFy19r79JNuV4KDqqgUj4Ewgd
+qp5AZ6WWsUt7EWvDLxvXA9pVYci7ebNtkvNZvhwUQFABigCy2jjDVNzhPQBk9/Hw
+f4n2iZaNKVZhcyt6XQUffiQltLAmKEBpBKlInP5mH1gRoWhYCG2tzovGNK9HyoNh
+h1H27u6c4JBft6XokBjjWALZ4TfdpBefzhy7Mf+sidvVcOS1vpGiZ0V1CPuN659O
+Bx9Gn2FZasegjBkB+/qVpl7vF0yf5Sf2R8TvIpd1Ko5ox2XNntvE85tsTtAk1KQW
+hIzSvrFvs0en8u0dUr9NiuDzRr7w0vm68jrPIydzwuwAgreItIMF4rh/IrLDcpek
+VLxyM8rtpo+2kwBA4noV
+=sQZ7
+-----END PGP SIGNATURE-----
+
+```
+
+<!-- END SIGNATURES -->
+
+### Begin signed statement 
+
+#### Expect
+
+```
+size  exec  file                   contents                                                                                                                         
+            ./                                                                                                                                                      
+7470          lisp-interpreter.pl  eafc6eb3c8a5ceeea3da0352031a3251fba59e9a7889b285c5328fa8abd5b899|b5046b37cb23c0ae81cbffc09037a0762bab6df6e92b1cb162725eb40b7dc318
+```
+
+#### Ignore
+
+```
+/SIGNED.md
+```
+
+#### Presets
+
+```
+git  # ignore .git and anything as described by .gitignore files
+```
+
+<!-- summarize version = 0.0.9 -->
+
+### End signed statement
+
+<hr>
+
+#### Notes
+
+With keybase you can sign any directory's contents, whether it's a git repo,
+source code distribution, or a personal documents folder. It aims to replace the drudgery of:
+
+  1. comparing a zipped file to a detached statement
+  2. downloading a public key
+  3. confirming it is in fact the author's by reviewing public statements they've made, using it
+
+All in one simple command:
+
+```bash
+keybase dir verify
+```
+
+There are lots of options, including assertions for automating your checks.
+
+For more info, check out https://keybase.io/docs/command_line/code_signing
\ No newline at end of file
diff --git a/lisp-interpreter.pl b/lisp-interpreter.pl
new file mode 100644
index 0000000..2be75cd
--- /dev/null
+++ b/lisp-interpreter.pl
@@ -0,0 +1,333 @@
+/*******************************************************************
+ *
+ * A Lisp interpreter, written in Prolog
+ *
+ * (lisp_interpreter.pl)
+ *
+ * (c) Neil Smith, 2001
+ *
+ * This program is a small interpreter for Lisp.  It was written
+ * in LPA Prolog v3.6, running under Windows.  It should be fairly
+ * easy to convert it to other Prologs.
+ *
+ * It supports real Lisp syntax, excessive brackets and all.  You don't 
+ * need to terminate input with a full stop.  It also understands 
+ * 'x for (quote x) and #'func for (function func)
+ *
+ * Variables are lexically scoped, except where defined as special.
+ *
+ * read_words code from "The Craft of Prolog", R.A.O'Keefe
+ * lisp evaluator from "Lisp" (3rd ed), Winston & Horn.
+ *
+ *******************************************************************/
+
+
+:- style_check.
+
+:- dynamic 
+	bindings/1,
+	lambda/2.
+
+% :- initialization lisp.
+
+
+bindings([]).
+
+
+lisp:-
+	write('Welcome to Pro-Lisp!'),nl,
+	write('This is a miniscule Lisp interpreter, written in Prolog'),nl,
+	prompt(Old, '> '),
+	prompts(Old1, Old2),
+	prompts('> ', '> '),
+	tidy_database,
+	repeat,
+	read_eval_print(Result),
+	Result = quit,
+	prompt(_, Old),
+	prompts(Old1, Old2).
+
+
+tidy_database:-
+	retract(bindings(_)),
+	assert(bindings([])),
+	retractall(lambda(_, _)).
+
+
+read_eval_print(Result):-		% dodgy use of cuts to force a single evaluation
+	read_and_parse(Expression),
+	eval(Expression, Result),
+	writeExpression(Result),
+	!.
+
+
+
+% basic EVAL statements for built-in procedures
+
+eval(Expression, Result):-
+	bindings(Bindings),
+	eval(Expression, Bindings, Result).
+
+
+macro_expand([],[]):-!.
+macro_expand([#, '''', X|Xs], [[function, MX]|MXs]):-
+	!,
+	macro_expand(X, MX),
+	macro_expand(Xs, MXs).
+macro_expand(['''', X|Xs], [[quote, MX]|MXs]):-
+	!,
+	macro_expand(X, MX),
+	macro_expand(Xs, MXs).
+macro_expand([X|Xs], [MX|MXs]):-
+	!,
+	macro_expand(X, MX),
+	macro_expand(Xs, MXs).
+macro_expand(X, X):-
+	atomic(X),
+	!.
+
+
+eval(quit, _, quit):-!.
+eval(nil, _, []):-!.
+eval(t, _, t):-!.
+eval([], _, []):-!.
+eval([quote, X], _, X):-!.
+eval([quit], _, quit):-!.
+eval([defvar, Name], _, Name):-
+	!,
+	retract(bindings(GlobalBindings)),
+	assert(bindings([binding(Name, [])|GlobalBindings])),
+	!.
+eval([setq, Name, Value], Bindings, EvalValue):-
+	!,
+	bindings(GlobalBindings),
+	append(Pre, [binding(Name, _)|Post], GlobalBindings),
+	eval(Value, Bindings, EvalValue),
+	retract(bindings(GlobalBindings)),
+	append(Pre, [binding(Name, EvalValue)|Post], GlobalBindings1),
+	assert(bindings(GlobalBindings1)),
+	!.
+eval([defun, Name, FormalParms, Body], _, Name):-
+	!,
+	assert(lambda(Name, [lambda, FormalParms, Body])),
+	!.
+eval([apply|Arguments], Bindings, Result):-
+	!,
+	evalL(Arguments, Bindings, [Function, ActualParams]),
+	apply(Function, ActualParams, Result),
+	!.
+eval([function, [lambda,  FormalParams, Body]], Bindings, 
+		[closure, FormalParams, Body, Bindings]):-!.
+eval([Procedure|Arguments], Bindings, Result):-
+	evalL(Arguments, Bindings, EvalArguments),
+	apply(Procedure, EvalArguments, Result),
+	!.
+eval(X, _, X):-
+	number(X),	
+	!.
+eval(X, Bindings, Val):-
+	atom(X),
+		member(binding(X, Val), Bindings)
+	;	(bindings(GlobalBindings),
+		 member(binding(X, Val), GlobalBindings)),
+	!.
+eval(X, _, []):-
+	write('ERROR!  Cannot find a binding for `'),
+	write(X),
+	write('`'),nl,
+	!.
+
+
+evalL([], _, []):-!.
+evalL([H|T], Bindings, [EvalH|EvalT]):-
+	eval(H, Bindings, EvalH),
+	evalL(T, Bindings, EvalT),
+	!.
+
+
+apply(car, [[Result|_]], Result):-!.
+apply(cdr, [[_|Result]], Result):-!.
+apply(list, Args, Args):-!.
+apply(cons, [Arg1, Arg2], [Arg1|Arg2]):-!.
+apply(eq, [Arg1, Arg2], Result):-
+	(Arg1 = Arg2 -> Result = Arg1 
+		      ; Result = []),
+	!.
+apply(if, [Test, Success, Failure], Result):-
+	eval(Test, TestResult),
+	eval(Success, EvalSuccess),
+	eval(Failure, EvalFailure),
+	(TestResult = [] -> Result = EvalFailure
+			  ; Result = EvalSuccess),
+	!.
+apply([lambda, FormalParams, Body], ActualParams, Result):-
+	!,
+	bind_variables(FormalParams, ActualParams, Bindings),
+	eval(Body, Bindings, Result),
+	!.
+apply([closure, FormalParams, Body, Bindings0], ActualParams, Result):-
+	!,
+	bind_variables(FormalParams, ActualParams, Bindings0, Bindings),
+	eval(Body, Bindings, Result),
+	!.
+apply(ProcedureName, Args, Result):-
+	lambda(ProcedureName, LambdaExpression),
+	apply(LambdaExpression, Args, Result),
+	!.
+apply(X, _, []):-
+	write('ERROR!  Cannot find a procedure description for `'),
+	write(X),
+	write('`'),nl,
+	!.
+	
+
+
+bind_variables(Formal, Actual, Bindings):-
+	bind_variables(Formal, Actual, [], Bindings).
+
+bind_variables([], [], Bindings, Bindings).
+bind_variables([FormalParam|FormalParams], [ActualParam|ActualParams],
+		Bindings0, Bindings):- 
+	bind_variables(FormalParams, ActualParams, 
+		[binding(FormalParam, ActualParam)|Bindings0], Bindings).
+
+
+
+
+% read and parse a line of Lisp
+
+read_and_parse(Expression):-
+	read_words(TokenL),
+	(	sexpr(Expression, TokenL, [])
+	;
+		( write('ERROR!  Could not parse `'),
+		  writeTokenL(TokenL),
+		  write('`'),nl,
+		  Expression = [] )
+	),
+	!.
+
+
+
+% read a line of supposed Lisp code
+
+read_words(Words):-
+	get0(C),
+	read_words(C, Words).
+
+read_words(C, []):-
+	ends_line(C),	
+	!.
+read_words(C, Words):-
+	whitespace(C),
+	!,
+	read_words(Words).
+read_words(C, [Word|Words]):-
+	punctuation(C),
+	!,
+	name(Word, [C]),
+	read_words(Words).
+read_words(C, [Word|Words]):-
+	other(C),
+	!,
+	read_rest_of_word(Chars, LeftOver),
+	name(UCWord, [C|Chars]),
+	( atom(UCWord) -> lwrupr(Word, UCWord)
+		;	
+		Word = UCWord),
+	read_words(LeftOver, Words).
+
+
+read_rest_of_word(Chars, LeftOver):-
+	get0(C),
+	read_rest_of_word(C, Chars, LeftOver).
+
+
+read_rest_of_word(C, [], C):-
+	\+ other(C),
+	!.
+read_rest_of_word(C, [C|Chars], LeftOver):-
+	other(C),
+	!,
+	read_rest_of_word(Chars, LeftOver).
+
+
+
+ends_line(10).
+ends_line(13).
+
+
+whitespace(9).
+whitespace(32).
+
+
+punctuation(0'.).
+punctuation(0'!).
+punctuation(0'").
+punctuation(0',).
+punctuation(0'').
+punctuation(0':).
+punctuation(0';).
+punctuation(0'?).
+punctuation(0'().
+punctuation(0')).
+punctuation(0'[).
+punctuation(0']).
+% punctuation(0'#).
+
+
+other(Char):-
+	integer(Char),
+	Char >= 0,
+	Char =< 127,
+	\+ ends_line(Char),
+	\+ whitespace(Char),
+	\+ punctuation(Char).
+
+
+% Grammar rules for parsing Lisp s-expressions.
+% Given a list of tokens, lisplist does all the nesting of lists
+
+
+sexpr([function, Expression]) --> [#, ''''], !, sexpr(Expression).
+sexpr([quote, Expression]) --> [''''], !, sexpr(Expression).
+sexpr(Xs) --> ['('], lisplist(Xs), !.
+sexpr(X) --> [X], {atomic(X), X \= '.'}, !.
+
+
+lisplist([]) --> [')'], !.
+lisplist([X|Xs]) --> sexpr(X), lisplist(Xs), !.
+lisplist([X|Y]) --> sexpr(X), ['.'], sexpr(Y), [')'], !.
+
+
+
+% writeExpression/1 displays a lisp expression
+
+writeExpression(quit):-
+	!,
+	write('Terminating Pro-Lisp'),nl.
+writeExpression(Expression):-
+	sexpr(Expression, TokenL, []),
+%	write('  '),
+	writeTokenL(TokenL),
+	nl.
+
+
+writeTokenL([]).
+writeTokenL(['(', ')'|TokenL]):-
+	!,
+	write('NIL '),
+	writeTokenL(TokenL).
+writeTokenL([Token|TokenL]):-
+	atom(Token),
+	!,
+	lwrupr(Token, UCToken),
+	write(UCToken),
+	write(' '),
+	writeTokenL(TokenL).
+writeTokenL([Token|TokenL]):-
+	number(Token),
+	!,
+	write(Token),
+	write(' '),
+	writeTokenL(TokenL).
-- 
2.43.0