Another Lisp interpreter, in Prolog

biglisp.pl

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).