From: Neil Smith Date: Fri, 10 Apr 2015 08:30:47 +0000 (+0100) Subject: Almost working X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=HEAD;p=lisp-compiler-in-prolog.git Almost working --- 155fa524e57affb645ba22f0be4c312c4fa670b2 diff --git a/.gitignore b/.gitignore new file mode 100644 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 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----- + +``` + + + +### 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 +``` + + + +### End signed statement + +
+ +#### 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 index 0000000..c6673d7 --- /dev/null +++ b/builtin_lisp_functions.pl @@ -0,0 +1,120 @@ +/******************************************************************* + * + * A Lisp compiler, written in Prolog + * + * (builtin_lisp_functions.pl) + * + * (c) Neil Smith, 2001 + * + * This program provides some built-in functionality for the + * Lisp compiler. It requires that the file lisp_compiler.pl has + * already been successfully compiled. + * + *******************************************************************/ + + + +:- ensure_loaded(library(writef)). +:- use_module(library(lists)). + + +first(List, Result):- + once(( List = [Result|_] + ; lisp_error_description(first_not_cons, ErrMsg), + throw(error(first_not_cons(List), context(first, ErrMsg))) )). + +rest(List, Result):- + once(( List = [_|Result] + ; lisp_error_description(rest_not_cons, ErrMsg), + throw(error(first_not_cons(List), context(first, ErrMsg))) )). + +cons(Item, List, Result):- + Result = [Item|List]. + +null(Item, Result):- + Item = [] + -> Result = t + ; Result = []. + +eq(Item1, Item2, Result):- + Item1 == Item2 + -> Result = t + ; Result = []. + +equalp(Item1, Item2, Result):- + Item1 = Item2 + -> Result = t + ; Result = []. + + +plus(Num1, Num2, Result):- + Result is Num1 + Num2. +minus(Num1, Num2, Result):- + Result is Num1 - Num2. +times(Num1, Num2, Result):- + Result is Num1 * Num2. +divide(Num1, Num2, Result):- + Result is Num1 / Num2. + + +lisp_not(Boolean, Result):- + Boolean = [] + -> Result = t + ; Result = []. + +or(Bool1, Bool2, Result):- + once(Bool1 \= [] ; Bool2 \= []) + -> Result = t + ; Result = []. + +and(Bool1, Bool2, Result):- + (Bool1 \= [] , Bool2 \= []) + -> Result = t + ; Result = []. + + +lisp_apply(FunctionObject, Arguments, Result):- + % FunctionObject = closure(FormalArgs, Body, Environment) + FunctionObject = closure(FormalArgs, Body, ClosureEnvironment, Environment) + -> % zip_with(FormalArgs, Arguments, [Arg, Val, binding(Arg, [Val|_])]^true, Bindings), + maplist(make_binding, FormalArgs, Arguments, Bindings), + append(ClosureEnvironment, Environment, ActualEnvironment), + % apply(Body, [[Bindings|Environment], Result]) + apply(Body, [[Bindings|ActualEnvironment], Result]) + ; FunctionObject = function(FunctionName), + append(Arguments, [Result], ArgumentsResult), + Function =.. [FunctionName|ArgumentsResult], + call(Function). + + +extract_variable_value([Val|Vals], FoundVal, Hole):- + var(Vals) + -> FoundVal = Val, + Hole = Vals + ; extract_variable_value(Vals, FoundVal, Hole). + + +lisp_call(Function, Result):- + apply(Function, [Result]). + + + +/* +show_special:- + setof(sv(Var, Value), special_var(Var, Value), SVs) + -> format('Variable ~tValue~n~n'), + maplist((sv(Var2, Value2), format('~w :~t~w~n', [Var2, Value2])), SVs) + ; format('No special variables~n'). +*/ + +show_special:- + setof(sv(Var, Value), special_var(Var, Value), SVs), + !, + format('Variable ~tValue~20|~n~n'), + % maplist((sv(Var2, Value2), format('~w :~t~w~n', [Var2, Value2])), SVs). + maplist(show_one_special, SVs). +show_special:- + format('No special variables~n'). + +show_one_special(sv(Var, Value)):- + 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 index 0000000..b7b5d97 --- /dev/null +++ b/lisp_compiler.pl @@ -0,0 +1,282 @@ +/******************************************************************* + * + * A Lisp compiler, written in Prolog + * + * (lisp_compiler.pl) + * + * (c) Neil Smith, 2001 + * + * This program, and its associated support files, forms a compiler + * for a subset of the language LISP. It supports a few simple + * built-in procedures, listed below. It also supports both special + * and lexical variables, and higher-order functions and lexical + * closures. + * + * This compiler was written in LPA Prolog v3.6 under MS Windows. + * It should run under other Prologs without too much conversion needed, + * but note the required library modules. + * + * + * Special forms + * + * [] and nil are treated as special forms, evaluating to [], and treated as 'false' + * t is a special form, evaluating to t, and treated as 'true' + * if, cond + * progn (and implicit progn in defun and let bodies) + * quote + * let + * setq + * function + * lambda + * defvar, defparameter (both with and without initial values) + * + * Built-in procedures (defined in builtin_lisp_functions.pl) + * + * cons, first, rest, null + * eq, equalp + * plus, minus, times, divide + * lisp_not, or, and + * lisp_apply + * + * Other procedures are defined in lisp_library.pl + * + *******************************************************************/ + +/******************************************************************* + * + * Example definitions: + * second(l) <<== first(rest(l)). + * list_3(a, b, c) <<== cons(a, cons(b, cons(c, nil))). + * + * Example use: + * ?| - lisp_call(second([a,b,c]), Result). + * Result = b + * + * ?| - second([a,b,c], Result). + * Result = b + * + * ?| - lisp_call(list_3(tom, dick, harry), Result). + * Result = [tom, dick, harry] + * + * ?| - list_3(tom, dick, harry, Result). + * Result = [tom, dick, harry] + * + *******************************************************************/ + +:- style_check([+singleton, +no_effect, +var_branches, +atom, +discontiguous, + +charset]). + +:- use_module(library(apply)). + +% :- ensure_loaded(library(higher_order)). +% :- ensure_loaded(library(list_utilities)). + + +% :- ensure_loaded(builtin_lisp_functions). % Lisp primitives: this directives is at the end of the file +% :- ensure_loaded(lisp_library). % Functions defined in lisp: this directive is at the end of the file + % allowing them to be compiled correctly + + +:- op(1200, xfx, <<== ). % function definition +:- op(1200, fx, <<== ). % functional imperative definition + +:- dynamic special_var/2. % closure environments + + +% Connection to LPA's built-in error handler + +/* +'?ERROR?'(Error, Form):- + lisp_error_description(_, Error, Description), + !, + write('LISP ERROR '), + write(Description), + write(Form), + nl. +'?ERROR?'(Error, Goal):- + error_hook(Error, Goal). +*/ + +lisp_error_description(unbound_atom, 'No value found for atom: '). +lisp_error_description(atom_does_not_exist, 'Setq: Variable does not exist: '). +lisp_error_description(first_not_cons, 'First: This is not a cons cell: '). +lisp_error_description(rest_not_cons, 'Rest: This is not a cons cell: '). + + +make_binding(Arg, Val, binding(Arg, [Val|_])). +make_environment(Variable, Form, bind(Variable, Form)). + + +% The hook into the compiler + +term_expansion( (FunctionHead <<== FunctionBody), + (Head :- Body) ):- + expand_function_head(FunctionHead, Head, ArgBindings, Result), + expand_function_body(implicit_progn(FunctionBody), Result, Body, [ArgBindings]). + +term_expansion( ( <<== FunctionBody), + ( :- Body) ):- + expand_function_body(implicit_progn(FunctionBody), _Result, Body, []). + + +expand_function_head(FunctionHead, Head, ArgBindings, Result):- + FunctionHead =.. [FunctionName | FormalArgs], + % compound_name_arguments(FunctionHead, FunctionName, FormalArgs), + % zip_with(FormalArgs, ActualArgs, [Arg, Val, binding(Arg, [Val|_])]^true, ArgBindings), + maplist(make_binding, FormalArgs, ActualArgs, ArgBindings), + append(ActualArgs, [Result], HeadArgs), + Head =.. [FunctionName | HeadArgs]. + % compound_name_arguments(Head, FunctionName, HeadArgs). + + +% expand_function_body(Function, Result, Body, Environment). +% Expands a Lisp-like function body into its Prolog equivalent +expand_function_body(nil, [], true, _Environment):- + !. +expand_function_body([], [], true, _Environment):- + !. +expand_function_body(t, t, true, _Environment):- + !. +expand_function_body(if(Test, IfTrue, IfFalse), Result, Body, Environment):- + !, + expand_function_body(Test, TestResult, TestBody, Environment), + expand_function_body(IfTrue, TrueResult, TrueBody, Environment), + expand_function_body(IfFalse, FalseResult, FalseBody, Environment), + Body = ( TestBody, + ( TestResult \= [] + -> TrueBody, + Result = TrueResult + ; FalseBody, + Result = FalseResult ) ). + +expand_function_body(cond([]), [], true, _Environment):- + !. +expand_function_body(cond([ [Test|ResultForms] |Clauses]), Result, Body, Environment):- + !, + expand_function_body(Test, TestResult, TestBody, Environment), + expand_progn(ResultForms, TestResult, ResultFormsResult, ResultFormsBody, Environment), + expand_function_body(cond(Clauses), ClausesResult, ClausesBody, Environment), + Body = ( TestBody, + ( TestResult \= [] + -> ResultFormsBody, + Result = ResultFormsResult + ; ClausesBody, + Result = ClausesResult ) ). + +expand_function_body(progn(Forms), Result, Body, Environment):- + !, + expand_progn(Forms, [], Result, Body, Environment). + +expand_function_body(implicit_progn(Forms), Result, Body, Environment):- + !, + % (once (Forms = [] ; Forms = [_|_] ) + is_list(Forms) + -> expand_progn(Forms, [], Result, Body, Environment) + ; expand_function_body(Forms, Result, Body, Environment). + + +expand_function_body(setq(Atom, ValueForm), Result, Body, Environment):- + !, + lisp_error_description(atom_does_not_exist, ErrMsg), + expand_function_body(ValueForm, Result, ValueBody, Environment), + Body = ( ValueBody, + ( member(Bindings, Environment), + member(binding(Atom, Value0), Bindings) + -> extract_variable_value(Value0, _, Hole), + Hole = [Result|_] + ; special_var(Atom, Old) + -> once(retract(special_var(Atom, Old))), + assert(special_var(Atom, Result)) + ; throw(error(atom_does_not_exist(Atom), context(setq, ErrMsg))) ) ). + +expand_function_body(quote(Item), Item, true, _Environment):- + !. + +expand_function_body(let(NewBindings, BodyForms), Result, Body, Environment):- + !, + % zip_with(Variables, ValueForms, [Variable, Form, bind(Variable, Form)]^true, NewBindings), + maplist(make_environment, Variables, ValueForms, NewBindings), + expand_arguments(ValueForms, ValueBody, Values, Environment), + % zip_with(Variables, Values, [Var, Val, binding(Var, [Val|_])]^true, Bindings), + maplist(make_binding, Variables, Values, Bindings), + Body = ( ValueBody, BodyFormsBody ), + expand_function_body(implicit_progn(BodyForms), Result, BodyFormsBody, + [Bindings|Environment]). + +expand_function_body(function(lambda(LambdaArgs, LambdaBody)), Result, Body, Environment):- + !, + expand_function_body(implicit_progn(LambdaBody), ClosureResult, ClosureBody, ClosureEnvironment), + Result = closure(LambdaArgs, + [ClosureEnvironment, ClosureResult]^ClosureBody, + Environment), + Body = true. + +expand_function_body(function(Function), function(Function), true, _Environment):- + !. + +expand_function_body(defvar(Var), Result, Body, Environment):- + !, + expand_function_body(defvar(Var, nil), Result, Body, Environment). +expand_function_body(defvar(Var, Value), Result, Body, Environment):- + !, + expand_function_body(Value, Result, ValueBody, Environment), + Body = ( ValueBody, + ( special_var(Var, _) + -> true + ; assert(special_var(Var, Result)) ) ). +expand_function_body(defparameter(Var), Result, Body, Environment):- + !, + expand_function_body(defparameter(Var, nil), Result, Body, Environment). +expand_function_body(defparameter(Var, Value), Result, Body, Environment):- + !, + expand_function_body(Value, Result, ValueBody, Environment), + Body = ( ValueBody, + ( special_var(Var, _) + -> one(retract(special_var(Var, _))) + ; true ), + assert(special_var(Var, Result)) ). + +expand_function_body(Number, Number, true, _Environment):- + number(Number), + !. + +expand_function_body(Atom, Value, Body, Environment):- + atom(Atom), + !, + lisp_error_description(unbound_atom, ErrMsg), + Body = (once(( member(Bindings, Environment), + member(binding(Atom, Value0), Bindings), + extract_variable_value(Value0, Value, _) + ; special_var(Atom, Value) + ; throw(error(unbound_atom(Atom), context(atom, ErrMsg))) )) ). + +% Non built-in function expands into an explicit function call +expand_function_body(Function, Result, Body, Environment):- + !, + Function =.. [FunctionName | FunctionArgs], + % compound_name_arguments(Function, FunctionName, FunctionArgs), + expand_arguments(FunctionArgs, ArgBody, Args, Environment), + append(Args, [Result], ArgsResult), + ExpandedFunction =.. [FunctionName | ArgsResult], + % compound_name_arguments(ExpandedFunction, FunctionName, ArgsResult), + Body = ( ArgBody, + ExpandedFunction ). + + expand_arguments([], true, [], _Environment). + expand_arguments([Arg|Args], Body, [Result|Results], Environment):- + expand_function_body(Arg, Result, ArgBody, Environment), + Body = (ArgBody, ArgsBody), + expand_arguments(Args, ArgsBody, Results, Environment). + + +expand_progn([], Result, Result, true, _Environment). +expand_progn([Form | Forms], _PreviousResult, Result, Body, Environment):- + expand_function_body(Form, FormResult, FormBody, Environment), + Body = (FormBody, FormsBody), + expand_progn(Forms, FormResult, Result, FormsBody, Environment). + + +% Now Prolog can understand them, compile the additional library files + +:- ensure_loaded(builtin_lisp_functions). +:- ensure_loaded(lisp_library). diff --git a/lisp_library.pl b/lisp_library.pl new file mode 100644 index 0000000..55e16e0 --- /dev/null +++ b/lisp_library.pl @@ -0,0 +1,53 @@ +/******************************************************************* + * + * A Lisp compiler, written in Prolog + * + * (lisp_library.pl) + * + * (c) Neil Smith, 2001 + * + * This program provides some built-in functionality for the + * Lisp compiler. It requires that the file lisp_compiler.pl has + * already been successfully compiled. + * + * Definitions in this file are given in the Lisp-like syntax + * read by this compiler. + * + *******************************************************************/ + + +second(l) <<== + first(rest(l)). + +third(l) <<== + first(rest(rest(l))). + + +% We don't support &rest parameters yet, so we need a different +% definition of list for every different number of arguments + +list_1(a) <<== + cons(a, nil). + +list_2(a, b) <<== + cons(a, list_1(b)). + +list_3(a, b, c) <<== + cons(a, list_2(b,c)). + + +lisp_append(l1, l2) <<== + if( null(l1), + l2, + cons( first(l1), + lisp_append(rest(l1), + l2))). + + +mapcar(func, l) <<== + if( null(l), + nil, + cons( lisp_apply(func, list_1(first(l))), + mapcar(func, rest(l)))). + + diff --git a/streams.pl b/streams.pl new file mode 100644 index 0000000..9a76364 --- /dev/null +++ b/streams.pl @@ -0,0 +1,63 @@ +/******************************************************************* + * + * A Lisp compiler, written in Prolog + * + * (streams_test.pl) + * + * (c) Neil Smith, 2001 + * + * The Lisp compiler supports lexical closures and other higher- + * order programming techniques. To demonsrate this, here is a + * simple and naive implementation of streams, and some examples + * of integer stream generators, including an infinite stream. + * Code for this program was taken from 'Structure and Interpretation + * of Computer Programs' by Abelson et al., and from 'Lisp' by + * Winston and Horn. + * + *******************************************************************/ + +stream_first(stream) <<== + first(stream). + +stream_rest(stream) <<== + lisp_apply(second(stream), []). + +stream_cons(a, b) <<== + list_2( a, b). + +stream_null(stream) <<== + null(stream). + + +% take the first n items from a stream, placing them in a normal list +stream_take(n, stream) <<== + if( or( equalp(n, 0), stream_null( stream)), + [], + cons(stream_first(stream), + stream_take(minus(n, 1), stream_rest( stream)))). + +% remove the first n items from a stream +stream_drop(n, stream) <<== + if( or( equalp( n, 0), stream_null( stream)), + stream, + stream_drop( minus( n, 1), stream_rest( stream))). + + +% creates a stream of integers from low to high +stream_interval(low, high) <<== + if( equalp(low, high), + [], + stream_cons( low, function(lambda([], stream_interval( plus( low, 1), high))))). + + +% creates an infinite stream of integers, starting at n +stream_ints_from(n) <<== + stream_cons( n, function(lambda([], stream_ints_from( plus( n, 1))))). + + +% tests on streams +t1 <<== + stream_take(3, stream_interval(1,5)). + +t2 <<== + stream_take(5, stream_drop(10, stream_ints_from(1))). diff --git a/tests.pl b/tests.pl new file mode 100644 index 0000000..32fdf83 --- /dev/null +++ b/tests.pl @@ -0,0 +1,73 @@ +/******************************************************************* + * + * A Lisp compiler, written in Prolog + * + * (tests.pl) + * + * (c) Neil Smith, 2001 + * + * A few sample function definitions, mainly used by me as simple + * test cases for the compiler. I'm sure you can come up with + * something better... + * + *******************************************************************/ + + + +simple(x) <<== x. + + +lisp_append_2(l1, l2) <<== + cond( [[null(l1), l2], + [t, cons( first(l1), + lisp_append_2(rest(l1), + l2))]]). + + +lisp_error(x) <<== setq(y, 5). + +lisp_let_simple <<== + let([bind(x, 10), bind(y, 20)], + x). + +lisp_let <<== + let([bind(x, 3), bind(y, 5)], + [x, y]). % implicit progn here + + +% maps 'first' over a list of lists +mapfirst(l) <<== + mapcar(function(first), l). + + +<<== defvar(fred, 13). + +<<== defvar(george). + + +reset_george(val) <<== + setq(george, val). + + +make_adder(x) <<== + function(lambda([y], plus(x, y))). + + +scale_list(xs, scale) <<== + let([bind(fred, function(lambda([num], times(scale, num))))], + mapcar(fred, xs)). + + +make_summer(total) <<== + function(lambda([n], + setq(total, plus(total, n)))). + + +sum_with_map(xs) <<== + let([bind(running_total, 0)], + let([bind(summer, function(lambda([n], setq(running_total, + plus(running_total, n)))))], + [ mapcar(summer, xs), + running_total ])). + +