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