Skip to content

Instantly share code, notes, and snippets.

@aphyr

aphyr/biglisp.pl

Created Oct 12, 2020
Embed
What would you like to do?
Another Lisp interpreter, in Prolog
use_module(library(lists)).
/* Bind updates a state given a list of binding names and a list of
corresponding values. The special binding form &(args) binds `args` to all
remaining arguments. Used to update contexts for e.g. function evaluation. */
bind(S, S, [], []).
/* Varargs */
bind(S1, S2, [&(Var)], Vals) :-
S2 = S1.put(Var, Vals).
bind(S1, S3, [Var | Vars], [Val | Vals]) :-
S2 = S1.put(Var, Val),
bind(S2, S3, Vars, Vals).
:- discontiguous ef/4.
/* Arithemetic */
ef(S1, SN, [add, X, Y], Res) :-
e(S1, S2, X, XRes),
e(S2, SN, Y, YRes),
Res is XRes + YRes.
ef(S1, SN, [subtract, X, Y], Res) :-
e(S1, S2, X, XRes),
e(S2, SN, Y, YRes),
Res is XRes - YRes.
/* quote is unevaluated */
ef(S, S, [quote, X], X).
/* atomq is basically any atomic thing. */
ef(S, S, [atomq, X], true) :-
atomic(X).
ef(S, S, [atomq, X], false) :-
compound(X).
/* equality helper; by the time we get here we BETTER ground out in actual
terms. There's probably a more concise way to write this, not sure. */
eq_raw(X, Y, true) :- X == Y.
eq_raw(X, Y, false) :- X \= Y.
/* eq */
ef(S1, SN, [eq, X, Y], Res) :-
e(S1, S2, X, XRes),
e(S2, SN, Y, YRes),
eq_raw(XRes, YRes, Res).
/* Numeric comparison helper */
less_raw(X, Y, true) :- X < Y.
less_raw(X, Y, false) :- X >= Y.
/* Is X < Y? */
ef(S1, SN, [less, X, Y], Res) :-
e(S1, S2, X, XRes),
e(S2, SN, Y, YRes),
less_raw(XRes, YRes, Res).
/* Boolean charge */
boolean_raw(X, true) :- X \= nil, X \= false.
boolean_raw(X, false) :- X == nil; X == false.
ef(S1, S2, [boolean, X], Res) :-
e(S1, S2, X, XRes),
boolean_raw(XRes, Res).
/* cons */
ef(S1, S2, [cons, X, nil], Res) :-
ef(S1, S2, [cons, X, []], Res).
ef(S1, S2, [cons, X, []], [Res]) :-
e(S1, S2, X, Res).
ef(S1, SN, [cons, X, Rest], [XRes | RestRes]) :-
e(S1, S2, X, XRes),
e(S2, SN, Rest, RestRes).
/* first, rest */
ef(S, S, [first, nil], nil).
ef(S, S, [first, []], nil).
ef(S, S, [first, [X | _]], X).
ef(S, S, [rest, nil], nil).
ef(S, S, [rest, []], nil).
ef(S, S, [rest, [_]], nil).
ef(S, S, [rest, [_ | More]], More).
/* if */
ef(S1, S2, [if, true, True, _False], Res) :-
e(S1, S2, True, Res).
ef(S1, S2, [if, false, _True, False], Res) :-
e(S1, S2, False, Res).
ef(S1, S3, [if, Test, True, False], Res) :-
e(S1, S2, [boolean, Test], TestRes),
ef(S2, S3, [if, TestRes, True, False], Res).
/* fn takes an arglist and a body, and closes over local scope. &(args) denotes
varargs. */
ef(S, S, [fn, Args | Body], Fun) :-
Fun = fn(S, Args, [do | Body]).
/* map-eval takes a list of expressions and returns those expressions, evaluated, as a list. */
ef(S, S, [map_eval], []).
ef(S1, S3, [map_eval, X | More], Res) :-
e(S1, S2, X, XRes),
ef(S2, S3, [map_eval | More], MoreRes),
Res = [XRes | MoreRes].
/* Function application proceeds by evaluating arguments, merging the current
interpreter state with the argument bindings, and evaluating body in that
context. The interpreter state resulting from function application is
discarded; functions can't alter global state. Later maybe we should have a Var
system. Also we don't do anything with the function's scope, so... later on,
merge that in too. I don't know how to merge dicts yet. */
ef(S1, SN, [fn(_FS, Bindings, Body) | Args], Res) :-
ef(S1, S2, [map_eval | Args], ArgsRes),
bind(S2, S3, Bindings, ArgsRes),
e(S3, SN, Body, Res).
/* def updates variables in the interpreter state. */
ef(S1, S3, [def, Var, Value], Value) :-
atom(Var),
e(S1, S2, Value, Res),
S3 = S2.put(Var, Res).
/* Can't do defn as a function until we allow functions to mutate the global
env. */
ef(S1, S2, [defn, Var, Args | Body], Res) :-
ef(S1, S2, [def, Var, [fn, Args | Body]], Res).
/* Do-notation evaluates sequentially */
ef(S, S, [do], nil).
ef(S1, S2, [do, X], Res) :-
e(S1, S2, X, Res).
ef(S1, S3, [do, X | More], Res) :-
e(S1, S2, X, _),
ef(S2, S3, [do | More], Res).
/* prn prints out stuff */
ef(S1, S2, [prn | Args], nil) :-
e(S1, S2, [map_eval | Args], ArgsRes),
write(ArgsRes).
/* Now that we can evaluate special forms, we move on to evaluating arbitrary
forms. */
/* e evaluates term X, producing Res. */
e(X, Res) :-
/* We start with bindings for special forms which resolve to themselves. */
e(st{add:add,
subtract:subtract,
atomq:atomq,
boolean:boolean,
cons:cons,
def:def,
defn:defn,
do:do,
eq:eq,
false:false,
first:first,
fn:fn,
if:if,
less:less,
map_eval:map_eval,
nil:nil,
prn:prn,
quote:quote,
rest:rest,
true:true},
_, X, Res).
/* Numbers, strings, etc. resolve to themselves. */
e(S, S, Term, Term) :-
string(Term) ;
number(Term).
/* Atoms are variables, which are resolved in the current context. */
e(S, S, Var, Res) :-
atom(Var),
Res = S.Var.
/* Empty lists eval to themselves. */
e(S, S, [], []).
/* Lists are evaluated by evaling the first thing--presumably to a special form
name like 'do, or a lambda like fn(...), then using ef to evaluate the
resulting form. */
e(S1, S3, [Verb | Args], Res) :-
e(S1, S2, Verb, VerbRes),
ef(S2, S3, [VerbRes | Args], Res).
/* Evaluate with prologue */
l(Res, Term) :-
Prologue = [
/* Increment */
[defn, inc, [x], [add, x, 1]],
/* Standard list constructor */
[defn, list, [&(more)],
more],
/* List of ints from min (inclusive) to max (exclusive). */
[defn, range, [min, max],
[if, [less, min, max],
[cons, min, [range, [inc, min], max]],
[]]],
/* Coerce empty sequences to nil, otherwise coll */
[defn, seq, [coll],
[if, [eq, coll, nil],
nil,
[if, [eq, coll, []],
nil,
coll]]],
/* Map function over collection. */
[defn, map, [f, coll],
[prn, "map", coll],
[if, [seq, coll],
[cons, [f, [first, coll]],
[map, f, [rest, coll]]],
[]]]
],
append(Prologue, [Term], Combined),
e([do | Combined], Res).
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.