examples: lisp — proper tail calls in eval
This commit is contained in:
@@ -6,7 +6,7 @@
|
||||
//
|
||||
// What this exercises across the ww language:
|
||||
// - tagged-union returns with many variants:
|
||||
// (*value | rterror) from eval / apply
|
||||
// (*value | rterror) from eval
|
||||
// (*value | parserr | eof) from the parser
|
||||
// - `match` with `yield` so the REPL dispatch is one expression
|
||||
// - `?` to propagate the error variant up the call chain
|
||||
@@ -983,174 +983,233 @@ fn apply_builtin(id: i32, xs: []*value) (*value | rterror) = {
|
||||
|
||||
// ---- eval -------------------------------------------------------------
|
||||
|
||||
export fn eval(v: *value, e: **env) (*value | rterror) = {
|
||||
// Self-evaluating atoms — every variant of `valkind` that isn't
|
||||
// SYM (lookup) or CONS (application).
|
||||
if (v.kind == valkind.NIL) { return v; };
|
||||
if (v.kind == valkind.BOOL) { return v; };
|
||||
if (v.kind == valkind.INT) { return v; };
|
||||
if (v.kind == valkind.FLOAT) { return v; };
|
||||
if (v.kind == valkind.STR) { return v; };
|
||||
if (v.kind == valkind.BUILTIN) { return v; };
|
||||
if (v.kind == valkind.LAMBDA) { return v; };
|
||||
// eval — drive the evaluation of a single form. Most paths are ordinary
|
||||
// recursion; tail positions (IF branch, last form of BEGIN/LET/lambda
|
||||
// body, and a tail call into another lambda) re-enter this loop with a
|
||||
// new (v, cure) instead of recursing, so deep tail-recursive Lisp code
|
||||
// doesn't grow the C stack one frame per call.
|
||||
//
|
||||
// Scope handling. `ein` is the *caller's* env slot. While evaluation
|
||||
// stays in the caller's scope (top-level work, IF, BEGIN), `define`/
|
||||
// `set!` mutate via `ein` so a top-level define lands in the caller's
|
||||
// global env. Once a tail-jump enters a fresh scope (LET binding,
|
||||
// lambda body), `tailed` flips and further `define`s are confined to
|
||||
// the local `cure` chain — same behavior as the pre-TCO code, where
|
||||
// LET/apply created their own `pe` local that died at scope exit.
|
||||
export fn eval(v0: *value, ein: **env) (*value | rterror) = {
|
||||
let v: *value = v0;
|
||||
let cure: *env = *ein;
|
||||
let tailed: bool = false;
|
||||
for (true) {
|
||||
// Self-evaluating atoms — every variant of `valkind` that
|
||||
// isn't SYM (lookup) or CONS (application).
|
||||
if (v.kind == valkind.NIL) { return v; };
|
||||
if (v.kind == valkind.BOOL) { return v; };
|
||||
if (v.kind == valkind.INT) { return v; };
|
||||
if (v.kind == valkind.FLOAT) { return v; };
|
||||
if (v.kind == valkind.STR) { return v; };
|
||||
if (v.kind == valkind.BUILTIN) { return v; };
|
||||
if (v.kind == valkind.LAMBDA) { return v; };
|
||||
|
||||
if (v.kind == valkind.SYM) {
|
||||
return env_lookup(*e, v.sid)?;
|
||||
};
|
||||
|
||||
// CONS — application. The head selects a special form (via symbol
|
||||
// id) or evaluates to a callable.
|
||||
let head: *value = v.car;
|
||||
let rest: *value = v.cdr;
|
||||
|
||||
if (head.kind == valkind.SYM) {
|
||||
let sf: sform = classify_sform(head.sid);
|
||||
if (sf != sform.NONE) {
|
||||
return eval_sform(sf, rest, e)?;
|
||||
if (v.kind == valkind.SYM) {
|
||||
return env_lookup(cure, v.sid)?;
|
||||
};
|
||||
};
|
||||
|
||||
let callee: *value = eval(head, e)?;
|
||||
// CONS — application. Head selects a special form (via
|
||||
// symbol id) or evaluates to a callable.
|
||||
let head: *value = v.car;
|
||||
let rest: *value = v.cdr;
|
||||
|
||||
// Inline the args walk: a separate `(slice | rterror)` return loses
|
||||
// xs.len through the wwstage cgen's 3-reg tagged-union convention
|
||||
// (AX=tag, DX=ptr, CX=cap — len is computed into BX and dropped).
|
||||
// Keeping the slice strictly local sidesteps that.
|
||||
let xs: []*value;
|
||||
xs.ptr = nil;
|
||||
xs.len = 0;
|
||||
xs.cap = 0;
|
||||
let cur: *value = rest;
|
||||
for (cur.kind == valkind.CONS) {
|
||||
let av = eval(cur.car, e)?;
|
||||
append(xs, av);
|
||||
cur = cur.cdr;
|
||||
};
|
||||
|
||||
return apply(callee, xs, e)?;
|
||||
};
|
||||
|
||||
// eval_sform — dispatch on the special-form tag. Each arm consumes a
|
||||
// specific shape of the rest-list and updates `e` if it must.
|
||||
fn eval_sform(sf: sform, rest: *value, e: **env) (*value | rterror) = {
|
||||
let tag: sform = sf;
|
||||
switch (tag) {
|
||||
case sform.QUOTE: {
|
||||
if (rest.kind != valkind.CONS) { return "quote: missing arg": rterror; };
|
||||
return rest.car;
|
||||
};
|
||||
case sform.IF: {
|
||||
if (list_len(rest) < 2) { return "if: need cond + then": rterror; };
|
||||
let cnd: *value = rest.car;
|
||||
let thn: *value = rest.cdr.car;
|
||||
let cv = eval(cnd, e)?;
|
||||
if (truthy(cv)) { return eval(thn, e)?; };
|
||||
let elsep: *value = rest.cdr.cdr;
|
||||
if (elsep.kind == valkind.CONS) {
|
||||
return eval(elsep.car, e)?;
|
||||
let sf: sform = sform.NONE;
|
||||
if (head.kind == valkind.SYM) {
|
||||
sf = classify_sform(head.sid);
|
||||
};
|
||||
return vnil();
|
||||
};
|
||||
case sform.DEFINE: {
|
||||
if (list_len(rest) != 2) { return "define: (define name expr)": rterror; };
|
||||
let nameval: *value = rest.car;
|
||||
if (nameval.kind != valkind.SYM) { return "define: name must be symbol": rterror; };
|
||||
let body: *value = rest.cdr.car;
|
||||
let bv = eval(body, e)?;
|
||||
env_define(e, nameval.sid, bv);
|
||||
// Recursive-lambda tie-back: prepend a self-binding frame
|
||||
// to the captured env so `(fact …)` inside fact's body
|
||||
// resolves. Earlier versions clobbered `bv.envp` with `*e`,
|
||||
// which wiped out any non-global env that closures (e.g.
|
||||
// `(adder 5)` returning `(lambda (x) (+ x k))`) had captured.
|
||||
if (bv.kind == valkind.LAMBDA) {
|
||||
let frame: *env = alloc(env{
|
||||
sid = nameval.sid,
|
||||
val = bv,
|
||||
next = bv.envp,
|
||||
});
|
||||
bv.envp = frame;
|
||||
};
|
||||
return vnil();
|
||||
};
|
||||
case sform.SETBANG: {
|
||||
if (list_len(rest) != 2) { return "set!: (set! name expr)": rterror; };
|
||||
let nameval: *value = rest.car;
|
||||
if (nameval.kind != valkind.SYM) { return "set!: name must be symbol": rterror; };
|
||||
let body: *value = rest.cdr.car;
|
||||
let bv = eval(body, e)?;
|
||||
env_set(*e, nameval.sid, bv)?;
|
||||
return bv;
|
||||
};
|
||||
case sform.LAMBDA: {
|
||||
if (list_len(rest) < 2) { return "lambda: (lambda (params) body...)": rterror; };
|
||||
let params: *value = rest.car;
|
||||
let body: *value = rest.cdr;
|
||||
return vlambda(params, body, *e);
|
||||
};
|
||||
case sform.LET: {
|
||||
// (let ((x v) (y w) ...) body...)
|
||||
if (list_len(rest) < 2) { return "let: (let ((b ...)) body)": rterror; };
|
||||
let binds: *value = rest.car;
|
||||
let body: *value = rest.cdr;
|
||||
let inner: *env = *e;
|
||||
let cur: *value = binds;
|
||||
for (cur.kind == valkind.CONS) {
|
||||
let pair: *value = cur.car;
|
||||
if (list_len(pair) != 2) { return "let: bad binding": rterror; };
|
||||
let nm: *value = pair.car;
|
||||
if (nm.kind != valkind.SYM) { return "let: name must be sym": rterror; };
|
||||
let val = eval(pair.cdr.car, e)?;
|
||||
let f: *env = alloc(env{ sid = nm.sid, val = val, next = inner });
|
||||
inner = f;
|
||||
cur = cur.cdr;
|
||||
};
|
||||
let inscope: *env = inner;
|
||||
let pe: *env = inscope;
|
||||
return run_body(body, &pe)?;
|
||||
};
|
||||
case sform.BEGIN: {
|
||||
return run_body(rest, e)?;
|
||||
};
|
||||
};
|
||||
return "bad sform": rterror;
|
||||
};
|
||||
|
||||
// run_body — evaluate a sequence of forms, returning the last value.
|
||||
fn run_body(forms: *value, e: **env) (*value | rterror) = {
|
||||
let result: *value = vnil();
|
||||
let cur: *value = forms;
|
||||
for (cur.kind == valkind.CONS) {
|
||||
result = eval(cur.car, e)?;
|
||||
cur = cur.cdr;
|
||||
};
|
||||
return result;
|
||||
};
|
||||
|
||||
// apply — call a BUILTIN or LAMBDA with already-evaluated args.
|
||||
fn apply(callee: *value, xs: []*value, e: **env) (*value | rterror) = {
|
||||
if (callee.kind == valkind.BUILTIN) {
|
||||
return apply_builtin(callee.ival: i32, xs)?;
|
||||
};
|
||||
if (callee.kind == valkind.LAMBDA) {
|
||||
// Extend the lambda's captured env with one frame per param.
|
||||
let inner: *env = callee.envp;
|
||||
let p: *value = callee.car;
|
||||
let i: i32 = 0;
|
||||
for (p.kind == valkind.CONS) {
|
||||
if (i >= xs.len) { return "lambda: too few args": rterror; };
|
||||
let nm: *value = p.car;
|
||||
if (nm.kind != valkind.SYM) { return "lambda: bad param": rterror; };
|
||||
let f: *env = alloc(env{ sid = nm.sid, val = xs[i], next = inner });
|
||||
inner = f;
|
||||
p = p.cdr;
|
||||
i += 1;
|
||||
if (sf == sform.QUOTE) {
|
||||
if (rest.kind != valkind.CONS) {
|
||||
return "quote: missing arg": rterror;
|
||||
};
|
||||
return rest.car;
|
||||
};
|
||||
if (i != xs.len) { return "lambda: too many args": rterror; };
|
||||
let pe: *env = inner;
|
||||
return run_body(callee.cdr, &pe)?;
|
||||
if (sf == sform.IF) {
|
||||
if (list_len(rest) < 2) {
|
||||
return "if: need cond + then": rterror;
|
||||
};
|
||||
let cnd: *value = rest.car;
|
||||
let thn: *value = rest.cdr.car;
|
||||
let cv = eval(cnd, &cure)?;
|
||||
if (truthy(cv)) {
|
||||
v = thn;
|
||||
continue;
|
||||
};
|
||||
let elsep: *value = rest.cdr.cdr;
|
||||
if (elsep.kind == valkind.CONS) {
|
||||
v = elsep.car;
|
||||
continue;
|
||||
};
|
||||
return vnil();
|
||||
};
|
||||
if (sf == sform.DEFINE) {
|
||||
if (list_len(rest) != 2) {
|
||||
return "define: (define name expr)": rterror;
|
||||
};
|
||||
let nameval: *value = rest.car;
|
||||
if (nameval.kind != valkind.SYM) {
|
||||
return "define: name must be symbol": rterror;
|
||||
};
|
||||
let body: *value = rest.cdr.car;
|
||||
let bv = eval(body, &cure)?;
|
||||
if (tailed) {
|
||||
env_define(&cure, nameval.sid, bv);
|
||||
} else {
|
||||
env_define(ein, nameval.sid, bv);
|
||||
cure = *ein;
|
||||
};
|
||||
// Recursive-lambda tie-back: prepend a self-binding
|
||||
// frame to the captured env so `(fact …)` inside
|
||||
// fact's body resolves. Earlier versions clobbered
|
||||
// `bv.envp` with `*e`, which wiped out any non-global
|
||||
// env that closures (e.g. `(adder 5)` returning
|
||||
// `(lambda (x) (+ x k))`) had captured.
|
||||
if (bv.kind == valkind.LAMBDA) {
|
||||
let frame: *env = alloc(env{
|
||||
sid = nameval.sid,
|
||||
val = bv,
|
||||
next = bv.envp,
|
||||
});
|
||||
bv.envp = frame;
|
||||
};
|
||||
return vnil();
|
||||
};
|
||||
if (sf == sform.SETBANG) {
|
||||
if (list_len(rest) != 2) {
|
||||
return "set!: (set! name expr)": rterror;
|
||||
};
|
||||
let nameval: *value = rest.car;
|
||||
if (nameval.kind != valkind.SYM) {
|
||||
return "set!: name must be symbol": rterror;
|
||||
};
|
||||
let body: *value = rest.cdr.car;
|
||||
let bv = eval(body, &cure)?;
|
||||
env_set(cure, nameval.sid, bv)?;
|
||||
return bv;
|
||||
};
|
||||
if (sf == sform.LAMBDA) {
|
||||
if (list_len(rest) < 2) {
|
||||
return "lambda: (lambda (params) body...)": rterror;
|
||||
};
|
||||
let params: *value = rest.car;
|
||||
let body: *value = rest.cdr;
|
||||
return vlambda(params, body, cure);
|
||||
};
|
||||
if (sf == sform.LET) {
|
||||
// (let ((x v) (y w) ...) body...). Bindings see the
|
||||
// outer scope; the body sees `inner`.
|
||||
if (list_len(rest) < 2) {
|
||||
return "let: (let ((b ...)) body)": rterror;
|
||||
};
|
||||
let binds: *value = rest.car;
|
||||
let body: *value = rest.cdr;
|
||||
let inner: *env = cure;
|
||||
let bcur: *value = binds;
|
||||
for (bcur.kind == valkind.CONS) {
|
||||
let pair: *value = bcur.car;
|
||||
if (list_len(pair) != 2) {
|
||||
return "let: bad binding": rterror;
|
||||
};
|
||||
let nm: *value = pair.car;
|
||||
if (nm.kind != valkind.SYM) {
|
||||
return "let: name must be sym": rterror;
|
||||
};
|
||||
let val = eval(pair.cdr.car, &cure)?;
|
||||
let f: *env = alloc(env{
|
||||
sid = nm.sid, val = val, next = inner,
|
||||
});
|
||||
inner = f;
|
||||
bcur = bcur.cdr;
|
||||
};
|
||||
cure = inner;
|
||||
tailed = true;
|
||||
// All-but-last in non-tail; last via loop jump.
|
||||
let bf: *value = body;
|
||||
for (bf.cdr.kind == valkind.CONS) {
|
||||
eval(bf.car, &cure)?;
|
||||
bf = bf.cdr;
|
||||
};
|
||||
v = bf.car;
|
||||
continue;
|
||||
};
|
||||
if (sf == sform.BEGIN) {
|
||||
if (rest.kind != valkind.CONS) { return vnil(); };
|
||||
let bf: *value = rest;
|
||||
for (bf.cdr.kind == valkind.CONS) {
|
||||
eval(bf.car, &cure)?;
|
||||
bf = bf.cdr;
|
||||
};
|
||||
v = bf.car;
|
||||
continue;
|
||||
};
|
||||
|
||||
// Normal application: evaluate head, then args, dispatch.
|
||||
let callee: *value = eval(head, &cure)?;
|
||||
|
||||
// Inline the args walk: a separate `(slice | rterror)`
|
||||
// return loses xs.len through the wwstage cgen's 3-reg
|
||||
// tagged-union convention (AX=tag, DX=ptr, CX=cap — len
|
||||
// is computed into BX and dropped). Keeping the slice
|
||||
// strictly local sidesteps that.
|
||||
let xs: []*value;
|
||||
xs.ptr = nil;
|
||||
xs.len = 0;
|
||||
xs.cap = 0;
|
||||
let acur: *value = rest;
|
||||
for (acur.kind == valkind.CONS) {
|
||||
let av = eval(acur.car, &cure)?;
|
||||
append(xs, av);
|
||||
acur = acur.cdr;
|
||||
};
|
||||
|
||||
if (callee.kind == valkind.BUILTIN) {
|
||||
return apply_builtin(callee.ival: i32, xs)?;
|
||||
};
|
||||
if (callee.kind == valkind.LAMBDA) {
|
||||
// Extend the lambda's captured env with one frame
|
||||
// per param, then tail-jump into the body.
|
||||
let inner: *env = callee.envp;
|
||||
let p: *value = callee.car;
|
||||
let i: i32 = 0;
|
||||
for (p.kind == valkind.CONS) {
|
||||
if (i >= xs.len) {
|
||||
return "lambda: too few args": rterror;
|
||||
};
|
||||
let nm: *value = p.car;
|
||||
if (nm.kind != valkind.SYM) {
|
||||
return "lambda: bad param": rterror;
|
||||
};
|
||||
let f: *env = alloc(env{
|
||||
sid = nm.sid, val = xs[i], next = inner,
|
||||
});
|
||||
inner = f;
|
||||
p = p.cdr;
|
||||
i += 1;
|
||||
};
|
||||
if (i != xs.len) {
|
||||
return "lambda: too many args": rterror;
|
||||
};
|
||||
cure = inner;
|
||||
tailed = true;
|
||||
let bod: *value = callee.cdr;
|
||||
for (bod.cdr.kind == valkind.CONS) {
|
||||
eval(bod.car, &cure)?;
|
||||
bod = bod.cdr;
|
||||
};
|
||||
v = bod.car;
|
||||
continue;
|
||||
};
|
||||
return "not callable": rterror;
|
||||
};
|
||||
return "not callable": rterror;
|
||||
// Unreachable — every path inside the loop returns or continues.
|
||||
return vnil();
|
||||
};
|
||||
|
||||
// ---- printer ---------------------------------------------------------
|
||||
|
||||
Reference in New Issue
Block a user