Added interpreter file
authorNeil Smith <neil.git@njae.me.uk>
Sun, 5 Apr 2015 17:03:16 +0000 (18:03 +0100)
committerNeil Smith <neil.git@njae.me.uk>
Sun, 5 Apr 2015 17:03:16 +0000 (18:03 +0100)
SIGNED.md [new file with mode: 0644]
lisp-interpreter.pl [new file with mode: 0644]

diff --git a/SIGNED.md b/SIGNED.md
new file mode 100644 (file)
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 (file)
index 0000000..2be75cd
--- /dev/null
@@ -0,0 +1,333 @@
+/*******************************************************************\r
+ *\r
+ * A Lisp interpreter, written in Prolog\r
+ *\r
+ * (lisp_interpreter.pl)\r
+ *\r
+ * (c) Neil Smith, 2001\r
+ *\r
+ * This program is a small interpreter for Lisp.  It was written\r
+ * in LPA Prolog v3.6, running under Windows.  It should be fairly\r
+ * easy to convert it to other Prologs.\r
+ *\r
+ * It supports real Lisp syntax, excessive brackets and all.  You don't \r
+ * need to terminate input with a full stop.  It also understands \r
+ * 'x for (quote x) and #'func for (function func)\r
+ *\r
+ * Variables are lexically scoped, except where defined as special.\r
+ *\r
+ * read_words code from "The Craft of Prolog", R.A.O'Keefe\r
+ * lisp evaluator from "Lisp" (3rd ed), Winston & Horn.\r
+ *\r
+ *******************************************************************/\r
+\r
+\r
+:- style_check.\r
+\r
+:- dynamic \r
+       bindings/1,\r
+       lambda/2.\r
+\r
+% :- initialization lisp.\r
+\r
+\r
+bindings([]).\r
+\r
+\r
+lisp:-\r
+       write('Welcome to Pro-Lisp!'),nl,\r
+       write('This is a miniscule Lisp interpreter, written in Prolog'),nl,\r
+       prompt(Old, '> '),\r
+       prompts(Old1, Old2),\r
+       prompts('> ', '> '),\r
+       tidy_database,\r
+       repeat,\r
+       read_eval_print(Result),\r
+       Result = quit,\r
+       prompt(_, Old),\r
+       prompts(Old1, Old2).\r
+\r
+\r
+tidy_database:-\r
+       retract(bindings(_)),\r
+       assert(bindings([])),\r
+       retractall(lambda(_, _)).\r
+\r
+\r
+read_eval_print(Result):-              % dodgy use of cuts to force a single evaluation\r
+       read_and_parse(Expression),\r
+       eval(Expression, Result),\r
+       writeExpression(Result),\r
+       !.\r
+\r
+\r
+\r
+% basic EVAL statements for built-in procedures\r
+\r
+eval(Expression, Result):-\r
+       bindings(Bindings),\r
+       eval(Expression, Bindings, Result).\r
+\r
+\r
+macro_expand([],[]):-!.\r
+macro_expand([#, '''', X|Xs], [[function, MX]|MXs]):-\r
+       !,\r
+       macro_expand(X, MX),\r
+       macro_expand(Xs, MXs).\r
+macro_expand(['''', X|Xs], [[quote, MX]|MXs]):-\r
+       !,\r
+       macro_expand(X, MX),\r
+       macro_expand(Xs, MXs).\r
+macro_expand([X|Xs], [MX|MXs]):-\r
+       !,\r
+       macro_expand(X, MX),\r
+       macro_expand(Xs, MXs).\r
+macro_expand(X, X):-\r
+       atomic(X),\r
+       !.\r
+\r
+\r
+eval(quit, _, quit):-!.\r
+eval(nil, _, []):-!.\r
+eval(t, _, t):-!.\r
+eval([], _, []):-!.\r
+eval([quote, X], _, X):-!.\r
+eval([quit], _, quit):-!.\r
+eval([defvar, Name], _, Name):-\r
+       !,\r
+       retract(bindings(GlobalBindings)),\r
+       assert(bindings([binding(Name, [])|GlobalBindings])),\r
+       !.\r
+eval([setq, Name, Value], Bindings, EvalValue):-\r
+       !,\r
+       bindings(GlobalBindings),\r
+       append(Pre, [binding(Name, _)|Post], GlobalBindings),\r
+       eval(Value, Bindings, EvalValue),\r
+       retract(bindings(GlobalBindings)),\r
+       append(Pre, [binding(Name, EvalValue)|Post], GlobalBindings1),\r
+       assert(bindings(GlobalBindings1)),\r
+       !.\r
+eval([defun, Name, FormalParms, Body], _, Name):-\r
+       !,\r
+       assert(lambda(Name, [lambda, FormalParms, Body])),\r
+       !.\r
+eval([apply|Arguments], Bindings, Result):-\r
+       !,\r
+       evalL(Arguments, Bindings, [Function, ActualParams]),\r
+       apply(Function, ActualParams, Result),\r
+       !.\r
+eval([function, [lambda,  FormalParams, Body]], Bindings, \r
+               [closure, FormalParams, Body, Bindings]):-!.\r
+eval([Procedure|Arguments], Bindings, Result):-\r
+       evalL(Arguments, Bindings, EvalArguments),\r
+       apply(Procedure, EvalArguments, Result),\r
+       !.\r
+eval(X, _, X):-\r
+       number(X),      \r
+       !.\r
+eval(X, Bindings, Val):-\r
+       atom(X),\r
+               member(binding(X, Val), Bindings)\r
+       ;       (bindings(GlobalBindings),\r
+                member(binding(X, Val), GlobalBindings)),\r
+       !.\r
+eval(X, _, []):-\r
+       write('ERROR!  Cannot find a binding for `'),\r
+       write(X),\r
+       write('`'),nl,\r
+       !.\r
+\r
+\r
+evalL([], _, []):-!.\r
+evalL([H|T], Bindings, [EvalH|EvalT]):-\r
+       eval(H, Bindings, EvalH),\r
+       evalL(T, Bindings, EvalT),\r
+       !.\r
+\r
+\r
+apply(car, [[Result|_]], Result):-!.\r
+apply(cdr, [[_|Result]], Result):-!.\r
+apply(list, Args, Args):-!.\r
+apply(cons, [Arg1, Arg2], [Arg1|Arg2]):-!.\r
+apply(eq, [Arg1, Arg2], Result):-\r
+       (Arg1 = Arg2 -> Result = Arg1 \r
+                     ; Result = []),\r
+       !.\r
+apply(if, [Test, Success, Failure], Result):-\r
+       eval(Test, TestResult),\r
+       eval(Success, EvalSuccess),\r
+       eval(Failure, EvalFailure),\r
+       (TestResult = [] -> Result = EvalFailure\r
+                         ; Result = EvalSuccess),\r
+       !.\r
+apply([lambda, FormalParams, Body], ActualParams, Result):-\r
+       !,\r
+       bind_variables(FormalParams, ActualParams, Bindings),\r
+       eval(Body, Bindings, Result),\r
+       !.\r
+apply([closure, FormalParams, Body, Bindings0], ActualParams, Result):-\r
+       !,\r
+       bind_variables(FormalParams, ActualParams, Bindings0, Bindings),\r
+       eval(Body, Bindings, Result),\r
+       !.\r
+apply(ProcedureName, Args, Result):-\r
+       lambda(ProcedureName, LambdaExpression),\r
+       apply(LambdaExpression, Args, Result),\r
+       !.\r
+apply(X, _, []):-\r
+       write('ERROR!  Cannot find a procedure description for `'),\r
+       write(X),\r
+       write('`'),nl,\r
+       !.\r
+       \r
+\r
+\r
+bind_variables(Formal, Actual, Bindings):-\r
+       bind_variables(Formal, Actual, [], Bindings).\r
+\r
+bind_variables([], [], Bindings, Bindings).\r
+bind_variables([FormalParam|FormalParams], [ActualParam|ActualParams],\r
+               Bindings0, Bindings):- \r
+       bind_variables(FormalParams, ActualParams, \r
+               [binding(FormalParam, ActualParam)|Bindings0], Bindings).\r
+\r
+\r
+\r
+\r
+% read and parse a line of Lisp\r
+\r
+read_and_parse(Expression):-\r
+       read_words(TokenL),\r
+       (       sexpr(Expression, TokenL, [])\r
+       ;\r
+               ( write('ERROR!  Could not parse `'),\r
+                 writeTokenL(TokenL),\r
+                 write('`'),nl,\r
+                 Expression = [] )\r
+       ),\r
+       !.\r
+\r
+\r
+\r
+% read a line of supposed Lisp code\r
+\r
+read_words(Words):-\r
+       get0(C),\r
+       read_words(C, Words).\r
+\r
+read_words(C, []):-\r
+       ends_line(C),   \r
+       !.\r
+read_words(C, Words):-\r
+       whitespace(C),\r
+       !,\r
+       read_words(Words).\r
+read_words(C, [Word|Words]):-\r
+       punctuation(C),\r
+       !,\r
+       name(Word, [C]),\r
+       read_words(Words).\r
+read_words(C, [Word|Words]):-\r
+       other(C),\r
+       !,\r
+       read_rest_of_word(Chars, LeftOver),\r
+       name(UCWord, [C|Chars]),\r
+       ( atom(UCWord) -> lwrupr(Word, UCWord)\r
+               ;       \r
+               Word = UCWord),\r
+       read_words(LeftOver, Words).\r
+\r
+\r
+read_rest_of_word(Chars, LeftOver):-\r
+       get0(C),\r
+       read_rest_of_word(C, Chars, LeftOver).\r
+\r
+\r
+read_rest_of_word(C, [], C):-\r
+       \+ other(C),\r
+       !.\r
+read_rest_of_word(C, [C|Chars], LeftOver):-\r
+       other(C),\r
+       !,\r
+       read_rest_of_word(Chars, LeftOver).\r
+\r
+\r
+\r
+ends_line(10).\r
+ends_line(13).\r
+\r
+\r
+whitespace(9).\r
+whitespace(32).\r
+\r
+\r
+punctuation(0'.).\r
+punctuation(0'!).\r
+punctuation(0'").\r
+punctuation(0',).\r
+punctuation(0'').\r
+punctuation(0':).\r
+punctuation(0';).\r
+punctuation(0'?).\r
+punctuation(0'().\r
+punctuation(0')).\r
+punctuation(0'[).\r
+punctuation(0']).\r
+% punctuation(0'#).\r
+\r
+\r
+other(Char):-\r
+       integer(Char),\r
+       Char >= 0,\r
+       Char =< 127,\r
+       \+ ends_line(Char),\r
+       \+ whitespace(Char),\r
+       \+ punctuation(Char).\r
+\r
+\r
+% Grammar rules for parsing Lisp s-expressions.\r
+% Given a list of tokens, lisplist does all the nesting of lists\r
+\r
+\r
+sexpr([function, Expression]) --> [#, ''''], !, sexpr(Expression).\r
+sexpr([quote, Expression]) --> [''''], !, sexpr(Expression).\r
+sexpr(Xs) --> ['('], lisplist(Xs), !.\r
+sexpr(X) --> [X], {atomic(X), X \= '.'}, !.\r
+\r
+\r
+lisplist([]) --> [')'], !.\r
+lisplist([X|Xs]) --> sexpr(X), lisplist(Xs), !.\r
+lisplist([X|Y]) --> sexpr(X), ['.'], sexpr(Y), [')'], !.\r
+\r
+\r
+\r
+% writeExpression/1 displays a lisp expression\r
+\r
+writeExpression(quit):-\r
+       !,\r
+       write('Terminating Pro-Lisp'),nl.\r
+writeExpression(Expression):-\r
+       sexpr(Expression, TokenL, []),\r
+%      write('  '),\r
+       writeTokenL(TokenL),\r
+       nl.\r
+\r
+\r
+writeTokenL([]).\r
+writeTokenL(['(', ')'|TokenL]):-\r
+       !,\r
+       write('NIL '),\r
+       writeTokenL(TokenL).\r
+writeTokenL([Token|TokenL]):-\r
+       atom(Token),\r
+       !,\r
+       lwrupr(Token, UCToken),\r
+       write(UCToken),\r
+       write(' '),\r
+       writeTokenL(TokenL).\r
+writeTokenL([Token|TokenL]):-\r
+       number(Token),\r
+       !,\r
+       write(Token),\r
+       write(' '),\r
+       writeTokenL(TokenL).\r