Almost working

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..5859a77
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,14 @@
+# cache files for sublime text
+*.tmlanguage.cache
+*.tmPreferences.cache
+*.stTheme.cache
+
+# workspace files are user-specific
+*.sublime-workspace
+
+# project files should be checked into the repository, unless a significant
+# proportion of contributors will probably not be using SublimeText
+# *.sublime-project
+
+# sftp configuration file
+sftp-config.json
\ No newline at end of file

diff --git a/SIGNED.md b/SIGNED.md
new file mode 100644 (file)
index 0000000..57794eb
--- /dev/null
+++ b/SIGNED.md
@@ -0,0 +1,75 @@
+##### Signed by https://keybase.io/neilnjae
+```
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v2
+
+iQIcBAABAgAGBQJVJ4o7AAoJEJPB2e07PgbqrpMP/ju1Xke684vCgF/LwxKL8ZAD
+DiEJySNV0YYvJG/huiiCU5KPfV0iodL4k4z85zFKEUJz64aN40o1YM4GT8IMqj6S
+Y8RoTCC+D1NJcb8WPuRYiGNhq3wS1qBJfl3CTEtZgnMga4N4vghEf5K/eEjh8gzq
+Ih49FF32pSo0rRBIXqSdaq2Yvy7wgaNVwebIEIUh4gx2RszyXIOos+3oHBzEEBUZ
+2gO5P5EaTNeDF3f0o+CBVForAutceP0JsUag7vOg9F8N4Q5ONimUO7QNs375lPTI
+C4VQ84Gy8L8liyfHUrJyXiPOpEql35oNXAjXxWfDkzNFljYGyIZy5cBWYTgyg4td
+CrN8zvq2M5F2TLRp5lgIQOpkpYVMzP5hMCeTLi1o69IluTyOAkNowNl3fSiyPOMK
+xXOrZ6S4CP4RFqU7ypV/U3D3sVCUwao4T+RsgAKCEidLt2i8DFsSbRYZuTXwGqoT
+8muUTI113ikZnEdspnCdi+FWOm5avyca1zyYxtmNXTi6J3rxCY8pR7Ex15x/Gpnv
+9EmwKA8tInUNNWWRQsQCYOmop/JxNmYdwu+9+m7dFtJ5TnccFOET2szGlI/Z24Gl
+SU5TmSWp/D1uD8ZS8yqjlk+ooRmBKfAqtJVZJt9wp4VI62PsQRmHXAaVEuF+ZvR9
+Of+Bi1pANZSzfdlYNXiW
+=Zl1J
+-----END PGP SIGNATURE-----
+
+```
+
+<!-- END SIGNATURES -->
+
+### Begin signed statement 
+
+#### Expect
+
+```
+size  exec  file                         contents                                                                                                                         
+            ./                                                                                                                                                            
+353           .gitignore                 40827a01fd527e4c1eb5aac49bef7b0f4a370e79e965fc3cec0f5791a0e431f5                                                                 
+3120          builtin_lisp_functions.pl  e164da681333eabe8507d7c1b3ac24c5f1fe4dbb67878710915d8cb9a8c867fd|496fd3440bfb9712c59e40431460a82337f0d13805b61f88c138caf056db1ff5
+9960          lisp_compiler.pl           d0a7c1628adbe12848c2360de4a4416716840af219ba18f2b1983ce68adf84ff|abb142a660c2bd47d02f5f36d79f8dc927d64d8ff859c172516260a4a7ec32fd
+1127          lisp_library.pl            72d18ab0d2211624b3a3308085f263f2581f9c05c7bc496bc040d5385e238819|65b791caa595988b2c14f05afed4e95008d915fa93f4062b0605146813d98302
+1829          streams.pl                 08e70586a314cc22da921c67a4ff39c29b4c2984eafabbcca6783e44dd707de8|bceb48d648017db6c41b662f69751237450b0dc5780740e0b45d15871fc9913c
+1427          tests.pl                   cca11ebe4c58aebbcc86ed0fb49e97399477bed6c783025462c474fb8789e978|6ba1a776c7c14b39197ddb81864772a52cd0a54bcf02864af7e8a8ce370eaf4d
+```
+
+#### 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/builtin_lisp_functions.pl b/builtin_lisp_functions.pl
new file mode 100644 (file)
index 0000000..c6673d7
--- /dev/null
+++ b/builtin_lisp_functions.pl
@@ -0,0 +1,120 @@
+/*******************************************************************\r
+ *\r
+ * A Lisp compiler, written in Prolog\r
+ *\r
+ * (builtin_lisp_functions.pl)\r
+ *\r
+ * (c) Neil Smith, 2001\r
+ *\r
+ * This program provides some built-in functionality for the \r
+ * Lisp compiler.  It requires that the file lisp_compiler.pl has \r
+ * already been successfully compiled.\r
+ *\r
+ *******************************************************************/\r
+\r
+\r
+\r
+:- ensure_loaded(library(writef)).\r
+:- use_module(library(lists)).\r
+\r
+\r
+first(List, Result):-\r
+       once((  List = [Result|_]\r
+           ;   lisp_error_description(first_not_cons, ErrMsg),\r
+                       throw(error(first_not_cons(List), context(first, ErrMsg))) )).\r
+\r
+rest(List, Result):-\r
+       once((  List = [_|Result]\r
+           ;   lisp_error_description(rest_not_cons, ErrMsg),\r
+                       throw(error(first_not_cons(List), context(first, ErrMsg)))      )).\r
+\r
+cons(Item, List, Result):-\r
+       Result = [Item|List].\r
+\r
+null(Item, Result):-\r
+               Item = []\r
+       ->      Result = t\r
+       ;       Result = [].\r
+\r
+eq(Item1, Item2, Result):-\r
+               Item1 == Item2\r
+       ->      Result = t\r
+       ;       Result = [].\r
+\r
+equalp(Item1, Item2, Result):-\r
+               Item1 = Item2\r
+       ->      Result = t\r
+       ;       Result = [].\r
+\r
+\r
+plus(Num1, Num2, Result):-\r
+       Result is Num1 + Num2.\r
+minus(Num1, Num2, Result):-\r
+       Result is Num1 - Num2.\r
+times(Num1, Num2, Result):-\r
+       Result is Num1 * Num2.\r
+divide(Num1, Num2, Result):-\r
+       Result is Num1 / Num2.\r
+\r
+\r
+lisp_not(Boolean, Result):-\r
+               Boolean = []\r
+       ->      Result = t\r
+       ;       Result = [].\r
+\r
+or(Bool1, Bool2, Result):-\r
+               once(Bool1 \= [] ; Bool2 \= [])\r
+       ->      Result = t\r
+       ;       Result = [].\r
+\r
+and(Bool1, Bool2, Result):-\r
+               (Bool1 \= [] , Bool2 \= [])\r
+       ->      Result = t\r
+       ;       Result = [].\r
+\r
+\r
+lisp_apply(FunctionObject, Arguments, Result):-\r
+               % FunctionObject = closure(FormalArgs, Body, Environment)\r
+               FunctionObject = closure(FormalArgs, Body, ClosureEnvironment, Environment)\r
+       ->      % zip_with(FormalArgs, Arguments, [Arg, Val, binding(Arg, [Val|_])]^true, Bindings),\r
+               maplist(make_binding, FormalArgs, Arguments, Bindings),\r
+               append(ClosureEnvironment, Environment, ActualEnvironment),\r
+               % apply(Body, [[Bindings|Environment], Result])\r
+               apply(Body, [[Bindings|ActualEnvironment], Result])\r
+       ;       FunctionObject = function(FunctionName), \r
+               append(Arguments, [Result], ArgumentsResult),\r
+               Function =.. [FunctionName|ArgumentsResult],\r
+               call(Function).\r
+\r
+\r
+extract_variable_value([Val|Vals], FoundVal, Hole):-\r
+               var(Vals)\r
+       ->      FoundVal = Val,\r
+               Hole = Vals\r
+       ;       extract_variable_value(Vals, FoundVal, Hole).\r
+\r
+\r
+lisp_call(Function, Result):-\r
+       apply(Function, [Result]).\r
+\r
+\r
+\r
+/*\r
+show_special:-\r
+               setof(sv(Var, Value), special_var(Var, Value), SVs)\r
+       ->      format('Variable ~tValue~n~n'),\r
+               maplist((sv(Var2, Value2), format('~w :~t~w~n', [Var2, Value2])), SVs)\r
+       ;       format('No special variables~n').\r
+*/\r
+\r
+show_special:-\r
+       setof(sv(Var, Value), special_var(Var, Value), SVs),\r
+       !,\r
+       format('Variable ~tValue~20|~n~n'),\r
+       % maplist((sv(Var2, Value2), format('~w :~t~w~n', [Var2, Value2])), SVs).\r
+       maplist(show_one_special, SVs).\r
+show_special:-\r
+       format('No special variables~n').\r
+\r
+show_one_special(sv(Var, Value)):-\r
+       format('~w :~t~w~20|~n', [Var, Value]).
\ No newline at end of file

diff --git a/lisp_compiler.pl b/lisp_compiler.pl
new file mode 100644 (file)
index 0000000..b7b5d97
--- /dev/null
+++ b/lisp_compiler.pl
@@ -0,0 +1,282 @@
+/*******************************************************************\r
+ *\r
+ * A Lisp compiler, written in Prolog\r
+ *\r
+ * (lisp_compiler.pl)\r
+ *\r
+ * (c) Neil Smith, 2001\r
+ *\r
+ * This program, and its associated support files, forms a compiler\r
+ * for a subset of the language LISP.  It supports a few simple \r
+ * built-in procedures, listed below.  It also supports both special\r
+ * and lexical variables, and higher-order functions and lexical\r
+ * closures.\r
+ *\r
+ * This compiler was written in LPA Prolog v3.6 under MS Windows.\r
+ * It should run under other Prologs without too much conversion needed,\r
+ * but note the required library modules.\r
+ *\r
+ *\r
+ * Special forms\r
+ *\r
+ * [] and nil are treated as special forms, evaluating to [], and treated as 'false'\r
+ * t is a special form, evaluating to t, and treated as 'true'\r
+ * if, cond\r
+ * progn (and implicit progn in defun and let bodies)\r
+ * quote\r
+ * let\r
+ * setq\r
+ * function\r
+ * lambda\r
+ * defvar, defparameter (both with and without initial values)\r
+ * \r
+ * Built-in procedures (defined in builtin_lisp_functions.pl)\r
+ *\r
+ * cons, first, rest, null\r
+ * eq, equalp\r
+ * plus, minus, times, divide\r
+ * lisp_not, or, and\r
+ * lisp_apply\r
+ * \r
+ * Other procedures are defined in lisp_library.pl\r
+ *\r
+ *******************************************************************/\r
+\r
+/*******************************************************************\r
+ *\r
+ * Example definitions:\r
+ * second(l) <<== first(rest(l)).\r
+ * list_3(a, b, c) <<== cons(a, cons(b, cons(c, nil))).\r
+ * \r
+ * Example use:\r
+ * ?| - lisp_call(second([a,b,c]), Result).\r
+ * Result = b\r
+ *\r
+ * ?| - second([a,b,c], Result).\r
+ * Result = b\r
+ *\r
+ * ?| - lisp_call(list_3(tom, dick, harry), Result).\r
+ * Result = [tom, dick, harry]\r
+ * \r
+ * ?| - list_3(tom, dick, harry, Result).\r
+ * Result = [tom, dick, harry]\r
+ *\r
+ *******************************************************************/\r
+\r
+:- style_check([+singleton, +no_effect, +var_branches, +atom, +discontiguous, \r
+       +charset]).\r
+\r
+:- use_module(library(apply)).\r
+\r
+% :- ensure_loaded(library(higher_order)).\r
+% :- ensure_loaded(library(list_utilities)).\r
+\r
+\r
+% :- ensure_loaded(builtin_lisp_functions). % Lisp primitives: this directives is at the end of the file\r
+% :- ensure_loaded(lisp_library).      % Functions defined in lisp: this directive is at the end of the file\r
+                                       % allowing them to be compiled correctly\r
+\r
+\r
+:- op(1200, xfx, <<== ).       % function definition\r
+:- op(1200,  fx, <<== ).       % functional imperative definition\r
+\r
+:- dynamic special_var/2.      % closure environments\r
+\r
+\r
+% Connection to LPA's built-in error handler\r
+\r
+/*\r
+'?ERROR?'(Error, Form):-\r
+       lisp_error_description(_, Error, Description),\r
+       !,\r
+       write('LISP ERROR  '),\r
+       write(Description),\r
+       write(Form),\r
+       nl.\r
+'?ERROR?'(Error, Goal):-\r
+       error_hook(Error, Goal).\r
+*/\r
+\r
+lisp_error_description(unbound_atom,        'No value found for atom: ').\r
+lisp_error_description(atom_does_not_exist, 'Setq: Variable does not exist: ').\r
+lisp_error_description(first_not_cons,      'First: This is not a cons cell: ').\r
+lisp_error_description(rest_not_cons,       'Rest: This is not a cons cell: ').\r
+\r
+\r
+make_binding(Arg, Val, binding(Arg, [Val|_])).\r
+make_environment(Variable, Form, bind(Variable, Form)).\r
+\r
+\r
+% The hook into the compiler\r
+\r
+term_expansion( (FunctionHead <<== FunctionBody), \r
+               (Head         :-   Body) ):-\r
+       expand_function_head(FunctionHead, Head, ArgBindings, Result),\r
+       expand_function_body(implicit_progn(FunctionBody), Result, Body, [ArgBindings]).\r
+\r
+term_expansion( ( <<== FunctionBody), \r
+               ( :-   Body) ):-\r
+       expand_function_body(implicit_progn(FunctionBody), _Result, Body, []).\r
+\r
+\r
+expand_function_head(FunctionHead, Head, ArgBindings, Result):-\r
+       FunctionHead =.. [FunctionName | FormalArgs],\r
+       % compound_name_arguments(FunctionHead, FunctionName, FormalArgs),\r
+       % zip_with(FormalArgs, ActualArgs, [Arg, Val, binding(Arg, [Val|_])]^true, ArgBindings),\r
+       maplist(make_binding, FormalArgs, ActualArgs, ArgBindings),\r
+       append(ActualArgs, [Result], HeadArgs),\r
+       Head =.. [FunctionName | HeadArgs].\r
+       % compound_name_arguments(Head, FunctionName, HeadArgs).\r
+\r
+\r
+% expand_function_body(Function, Result, Body, Environment).\r
+% Expands a Lisp-like function body into its Prolog equivalent\r
+expand_function_body(nil, [], true, _Environment):-\r
+       !.\r
+expand_function_body([], [], true, _Environment):-\r
+       !.\r
+expand_function_body(t,   t,  true, _Environment):-\r
+       !.\r
+expand_function_body(if(Test, IfTrue, IfFalse), Result, Body, Environment):-\r
+       !,\r
+       expand_function_body(Test,    TestResult,  TestBody,  Environment),\r
+       expand_function_body(IfTrue,  TrueResult,  TrueBody,  Environment),\r
+       expand_function_body(IfFalse, FalseResult, FalseBody, Environment),\r
+       Body = (        TestBody,\r
+                       ( TestResult \= []\r
+                               ->      TrueBody,  \r
+                                       Result      = TrueResult\r
+                               ;       FalseBody, \r
+                                       Result      = FalseResult       ) ).\r
+\r
+expand_function_body(cond([]), [], true, _Environment):-\r
+       !.\r
+expand_function_body(cond([ [Test|ResultForms] |Clauses]), Result, Body, Environment):-\r
+       !,\r
+       expand_function_body(Test, TestResult, TestBody, Environment),\r
+       expand_progn(ResultForms, TestResult, ResultFormsResult, ResultFormsBody, Environment),\r
+       expand_function_body(cond(Clauses), ClausesResult, ClausesBody, Environment),\r
+       Body = (        TestBody,\r
+                       ( TestResult \= []\r
+                               ->      ResultFormsBody,\r
+                                       Result      = ResultFormsResult\r
+                               ;       ClausesBody,\r
+                                       Result      = ClausesResult )   ).\r
+\r
+expand_function_body(progn(Forms), Result, Body, Environment):-\r
+       !,\r
+       expand_progn(Forms, [], Result, Body, Environment).\r
+\r
+expand_function_body(implicit_progn(Forms), Result, Body, Environment):-\r
+       !,\r
+       % (once (Forms = [] ; Forms = [_|_] )\r
+       is_list(Forms)\r
+       ->  expand_progn(Forms, [], Result, Body, Environment)\r
+       ;   expand_function_body(Forms, Result, Body, Environment).\r
+\r
+\r
+expand_function_body(setq(Atom, ValueForm), Result, Body, Environment):-\r
+       !,\r
+       lisp_error_description(atom_does_not_exist, ErrMsg),\r
+       expand_function_body(ValueForm, Result, ValueBody, Environment),\r
+       Body = (        ValueBody,\r
+                       (       member(Bindings, Environment),\r
+                               member(binding(Atom, Value0), Bindings)\r
+                       ->      extract_variable_value(Value0, _, Hole),\r
+                               Hole = [Result|_]\r
+                       ;       special_var(Atom, Old)\r
+                       ->      once(retract(special_var(Atom, Old))),\r
+                               assert(special_var(Atom, Result))\r
+                       ;       throw(error(atom_does_not_exist(Atom), context(setq, ErrMsg)))  )       ).\r
+\r
+expand_function_body(quote(Item), Item, true, _Environment):-\r
+       !.\r
+\r
+expand_function_body(let(NewBindings, BodyForms), Result, Body, Environment):-\r
+       !,\r
+       % zip_with(Variables, ValueForms, [Variable, Form, bind(Variable, Form)]^true, NewBindings),\r
+       maplist(make_environment, Variables, ValueForms, NewBindings),\r
+       expand_arguments(ValueForms, ValueBody, Values, Environment),\r
+       % zip_with(Variables, Values, [Var, Val, binding(Var, [Val|_])]^true, Bindings),\r
+       maplist(make_binding, Variables, Values, Bindings),\r
+       Body = ( ValueBody, BodyFormsBody ),\r
+       expand_function_body(implicit_progn(BodyForms), Result, BodyFormsBody, \r
+               [Bindings|Environment]).\r
+\r
+expand_function_body(function(lambda(LambdaArgs, LambdaBody)), Result, Body, Environment):-\r
+       !,\r
+       expand_function_body(implicit_progn(LambdaBody), ClosureResult, ClosureBody, ClosureEnvironment),\r
+       Result = closure(LambdaArgs, \r
+                       [ClosureEnvironment, ClosureResult]^ClosureBody, \r
+                       Environment),\r
+       Body = true.\r
+\r
+expand_function_body(function(Function), function(Function), true, _Environment):-\r
+       !.\r
+\r
+expand_function_body(defvar(Var), Result, Body, Environment):-\r
+       !,\r
+       expand_function_body(defvar(Var, nil), Result, Body, Environment).\r
+expand_function_body(defvar(Var, Value), Result, Body, Environment):-\r
+       !,\r
+       expand_function_body(Value, Result, ValueBody, Environment),\r
+       Body = (        ValueBody,\r
+                       (       special_var(Var, _)\r
+                       ->      true\r
+                       ;       assert(special_var(Var, Result))        )       ).\r
+expand_function_body(defparameter(Var), Result, Body, Environment):-\r
+       !,\r
+       expand_function_body(defparameter(Var, nil), Result, Body, Environment).\r
+expand_function_body(defparameter(Var, Value), Result, Body, Environment):-\r
+       !,\r
+       expand_function_body(Value, Result, ValueBody, Environment),\r
+       Body = (        ValueBody,\r
+                       (       special_var(Var, _)\r
+                       ->      one(retract(special_var(Var, _)))\r
+                       ;       true    ),\r
+                       assert(special_var(Var, Result))        ).\r
+\r
+expand_function_body(Number, Number, true, _Environment):-\r
+       number(Number),\r
+       !.\r
+\r
+expand_function_body(Atom, Value, Body, Environment):-\r
+       atom(Atom),\r
+       !,\r
+       lisp_error_description(unbound_atom, ErrMsg),\r
+       Body = (once((  member(Bindings, Environment),\r
+                       member(binding(Atom, Value0), Bindings),\r
+                       extract_variable_value(Value0, Value, _)\r
+                   ;   special_var(Atom, Value)\r
+                   ;   throw(error(unbound_atom(Atom), context(atom, ErrMsg))) ))      ).      \r
+\r
+% Non built-in function expands into an explicit function call\r
+expand_function_body(Function, Result, Body, Environment):-\r
+       !,\r
+       Function =.. [FunctionName | FunctionArgs],\r
+       % compound_name_arguments(Function, FunctionName, FunctionArgs),\r
+       expand_arguments(FunctionArgs, ArgBody, Args, Environment),\r
+       append(Args, [Result], ArgsResult),\r
+       ExpandedFunction =.. [FunctionName | ArgsResult],\r
+       % compound_name_arguments(ExpandedFunction, FunctionName, ArgsResult),\r
+       Body = (        ArgBody,\r
+                       ExpandedFunction        ).\r
+\r
+       expand_arguments([], true, [], _Environment).\r
+       expand_arguments([Arg|Args], Body, [Result|Results], Environment):-\r
+               expand_function_body(Arg, Result, ArgBody, Environment),\r
+               Body = (ArgBody, ArgsBody),\r
+               expand_arguments(Args, ArgsBody, Results, Environment).\r
+\r
+\r
+expand_progn([], Result, Result, true, _Environment).\r
+expand_progn([Form | Forms], _PreviousResult, Result, Body, Environment):-\r
+       expand_function_body(Form, FormResult, FormBody, Environment),\r
+       Body = (FormBody, FormsBody),\r
+       expand_progn(Forms, FormResult, Result, FormsBody, Environment).\r
+\r
+\r
+% Now Prolog can understand them, compile the additional library files\r
+\r
+:- ensure_loaded(builtin_lisp_functions).\r
+:- ensure_loaded(lisp_library).\r

diff --git a/lisp_library.pl b/lisp_library.pl
new file mode 100644 (file)
index 0000000..55e16e0
--- /dev/null
+++ b/lisp_library.pl
@@ -0,0 +1,53 @@
+/*******************************************************************\r
+ *\r
+ * A Lisp compiler, written in Prolog\r
+ *\r
+ * (lisp_library.pl)\r
+ *\r
+ * (c) Neil Smith, 2001\r
+ *\r
+ * This program provides some built-in functionality for the \r
+ * Lisp compiler.  It requires that the file lisp_compiler.pl has \r
+ * already been successfully compiled.\r
+ *\r
+ * Definitions in this file are given in the Lisp-like syntax \r
+ * read by this compiler.\r
+ *\r
+ *******************************************************************/\r
+\r
+\r
+second(l) <<== \r
+       first(rest(l)).\r
+\r
+third(l) <<==\r
+       first(rest(rest(l))).\r
+\r
+\r
+% We don't support &rest parameters yet, so we need a different\r
+% definition of list for every different number of arguments\r
+\r
+list_1(a) <<== \r
+       cons(a, nil).\r
+\r
+list_2(a, b) <<== \r
+       cons(a, list_1(b)).\r
+\r
+list_3(a, b, c) <<== \r
+       cons(a, list_2(b,c)).\r
+\r
+\r
+lisp_append(l1, l2) <<==\r
+       if( null(l1), \r
+           l2, \r
+           cons( first(l1),\r
+                 lisp_append(rest(l1),\r
+                             l2))).\r
+ \r
+\r
+mapcar(func, l) <<==\r
+       if( null(l), \r
+               nil,\r
+               cons( lisp_apply(func, list_1(first(l))),\r
+                       mapcar(func, rest(l)))).\r
+\r
+\r

diff --git a/streams.pl b/streams.pl
new file mode 100644 (file)
index 0000000..9a76364
--- /dev/null
+++ b/streams.pl
@@ -0,0 +1,63 @@
+/*******************************************************************\r
+ *\r
+ * A Lisp compiler, written in Prolog\r
+ *\r
+ * (streams_test.pl)\r
+ *\r
+ * (c) Neil Smith, 2001\r
+ *\r
+ * The Lisp compiler supports lexical closures and other higher-\r
+ * order programming techniques.  To demonsrate this, here is a \r
+ * simple and naive implementation of streams, and some examples\r
+ * of integer stream generators, including an infinite stream. \r
+ * Code for this program was taken from 'Structure and Interpretation\r
+ * of Computer Programs' by Abelson et al., and from 'Lisp' by \r
+ * Winston and Horn.\r
+ *\r
+ *******************************************************************/\r
+\r
+stream_first(stream) <<==\r
+       first(stream).\r
+\r
+stream_rest(stream) <<==\r
+       lisp_apply(second(stream), []).\r
+\r
+stream_cons(a, b) <<==\r
+       list_2( a, b).\r
+\r
+stream_null(stream) <<==\r
+       null(stream).\r
+\r
+\r
+% take the first n items from a stream, placing them in a normal list\r
+stream_take(n, stream) <<==\r
+  if( or( equalp(n, 0), stream_null( stream)),\r
+      [],\r
+      cons(stream_first(stream), \r
+           stream_take(minus(n, 1), stream_rest( stream)))). \r
+\r
+% remove the first n items from a stream\r
+stream_drop(n, stream) <<==\r
+  if( or( equalp( n, 0), stream_null( stream)),\r
+      stream,\r
+      stream_drop( minus( n, 1), stream_rest( stream))).\r
+\r
+\r
+% creates a stream of integers from low to high\r
+stream_interval(low, high) <<==\r
+  if( equalp(low, high),\r
+    [],\r
+    stream_cons( low, function(lambda([], stream_interval( plus( low, 1), high))))). \r
+\r
+\r
+% creates an infinite stream of integers, starting at n\r
+stream_ints_from(n) <<==\r
+  stream_cons( n, function(lambda([], stream_ints_from( plus( n, 1))))).\r
+\r
+\r
+% tests on streams\r
+t1 <<==\r
+       stream_take(3, stream_interval(1,5)).\r
+\r
+t2 <<== \r
+       stream_take(5, stream_drop(10, stream_ints_from(1))).\r

diff --git a/tests.pl b/tests.pl
new file mode 100644 (file)
index 0000000..32fdf83
--- /dev/null
+++ b/tests.pl
@@ -0,0 +1,73 @@
+/*******************************************************************\r
+ *\r
+ * A Lisp compiler, written in Prolog\r
+ *\r
+ * (tests.pl)\r
+ *\r
+ * (c) Neil Smith, 2001\r
+ *\r
+ * A few sample function definitions, mainly used by me as simple \r
+ * test cases for the compiler.  I'm sure you can come up with \r
+ * something better...\r
+ *\r
+ *******************************************************************/\r
+\r
+\r
+\r
+simple(x) <<== x.\r
+\r
+\r
+lisp_append_2(l1, l2) <<==\r
+       cond(  [[null(l1), l2], \r
+               [t,     cons( first(l1),\r
+                             lisp_append_2(rest(l1),\r
+                                           l2))]]).\r
+ \r
+\r
+lisp_error(x) <<== setq(y, 5).\r
+\r
+lisp_let_simple <<==\r
+       let([bind(x, 10), bind(y, 20)],\r
+               x).\r
+\r
+lisp_let <<==\r
+       let([bind(x, 3), bind(y, 5)], \r
+               [x, y]).                % implicit progn here\r
+\r
+\r
+% maps 'first' over a list of lists\r
+mapfirst(l) <<==\r
+       mapcar(function(first), l).\r
+\r
+\r
+<<== defvar(fred, 13).\r
+\r
+<<== defvar(george).\r
+\r
+\r
+reset_george(val) <<==\r
+       setq(george, val).\r
+\r
+\r
+make_adder(x) <<==\r
+       function(lambda([y], plus(x, y))).\r
+\r
+\r
+scale_list(xs, scale) <<==\r
+       let([bind(fred, function(lambda([num], times(scale, num))))],\r
+               mapcar(fred, xs)).\r
+\r
+\r
+make_summer(total) <<== \r
+       function(lambda([n],\r
+               setq(total, plus(total, n)))).\r
+\r
+\r
+sum_with_map(xs) <<==\r
+       let([bind(running_total, 0)],\r
+               let([bind(summer, function(lambda([n], setq(running_total, \r
+                                                       plus(running_total, n)))))],\r
+               [ mapcar(summer, xs),\r
+                 running_total ])).\r
+\r
+\r