NOTE The implementation of eval_expr and the design of the stack in this chapter are rather ad-hoc, and I'm not particularly proud of them. Please skip to the next chapter if they offend you.

Continuations and tail recursion

Our eval_expr function has been implemented recursively — that is to say, when in the course of evaluating an expression it is necessary to evaluate a sub-expression, eval_expr calls itself to obtain the result.

This works fairly well, and is easy to follow, but the depth of recursion in our LISP environment is limited by the stack size of the interpreter. LISP code traditionally makes heavy use of recursion, and we would like to support this up to the limit of available memory.

Take the following pathological example:

(define (count n)
  (if (= n 0)
      0
      (+ 1 (count (- n 1)))))

The COUNT function will recurse to depth n and return the sum of n ones. Expressions such as (COUNT 10) should compute OK with our current interpreter, but even (COUNT 10000) is enough to cause a stack overflow on my machine.

To achieve this we will rewrite eval_expr as a loop, with helper functions to keep track of evaluations in progress and return the next expression to be evaluated. When there are no more expressions left, eval_expr can return the final result to the caller.

As eval_expr works through the tree of expressions, we will keep track of arguments evaluated and pending evaluation in a series of frames, linked together to form a stack. This is broadly the same way that the compiled version of the recursive eval_expr works; in this case we are replacing the machine code stack with a LISP data structure and manipulating it explicitly.

The stack can also be thought of as representing the future of the computation once the present expression has been evaluated. In this sense it is referred to as the current continuation.

Since any function which is called by eval_expr may not call eval_expr (to avoid recursion), we must integrate apply and builtin_apply into the body of eval_expr.

Implementation

A stack frame has the following form.

(parent env evaluated-op (pending-arg...) (evaluated-arg...) (body...))

parent is the stack frame corresponding to the parent expression (that is, the one which is waiting for the result of the current expression). env is the current environment, evaluated-op is the evaluated operator, and pending-arg... and evaluated-arg are the arguments pending and following evaluation respectively. body... are the expressions in the function body which are pending execution.

Rather than writing out long lists of car() and cdr(), we will define some helper functions to manipulate members of a list.

// list_get returns the k'th atom in a list.
// if the list is shorter, it returns NIL.
// assumes that CAR(NIL) is NIL and CDR(NIL) is NIL.
func list_get(list Atom, k int) Atom {
    for ; k != 0; k = k - 1 {
        list = cdr(list)
    }
    return car(list)
}

// list_reverse reverses a list in place.
func list_reverse(list *Atom) {
    tail := _nil
    for !nilp(*list) {
        p := cdr(*list)
        setcdr(*list, tail)
        tail = *list
        *list = p
    }
    *list = tail
}

// list_set updates the k'th value in a list.
// if the list is shorter, it updates the last atom in the list.
// assumes that CAR(NIL) is NIL and CDR(NIL) is NIL.
func list_set(list Atom, k int, value Atom) {
    for ; k != 0; k = k - 1 {
        list = cdr(list)
    }
    setcar(list, value)
}

Another function creates a new stack frame ready to start evaluating a new function call, with the specified parent, environment and list of arguments pending evaluation (the tail).

// create constants for reaching into the stack frame
const (
    FRAME_PARENT = 0
    FRAME_ENV    = 1
    FRAME_OP     = 2
    FRAME_TAIL   = 3
    FRAME_ARGS   = 4
    FRAME_BODY   = 5
)

// make_frame returns a frame.
// the standard layout of a frame makes it easy to use
// list_get to fetch values and list_set to update them.
func make_frame(parent, env, tail Atom) Atom {
    op, args, body := _nil, _nil, _nil
    return cons(parent, // depth == 0
        cons(env, // depth == 1
            cons(op, // depth == 2
                cons(tail, // depth == 3
                    cons(args, // depth == 4
                        cons(body, // depth == 5
                            _nil))))))
}

Here is the innermost part of our new exec_expr, which sets expr to the next part of the function body, and pops the stack when we have reached end of the body.

// eval_do_exec sets expr to the next part of the function
// body, and pops the stack when we have reached end of the body.
func eval_do_exec(stack, expr, env *Atom) error {
    *env = list_get(*stack, FRAME_ENV)
    body := list_get(*stack, FRAME_BODY)
    *expr = car(body)
    if body = cdr(body); nilp(body) {
        // finished function; pop the stack
        *stack = car(*stack)
    } else {
        list_set(*stack, FRAME_BODY, body)
    }
    return nil
}

This helper binds the function arguments into a new environment if they have not already been bound, then calls eval_do_exec to get the next expression in the body.

// eval_do_bind binds the function arguments into a new environment
// if they have not already been bound, then calls eval_do_exec to
// get the next expression in the body.
func eval_do_bind(stack, expr, env *Atom) error {
    body := list_get(*stack, FRAME_BODY)
    if !nilp(body) {
        return eval_do_exec(stack, expr, env)
    }
    op := list_get(*stack, FRAME_OP)
    args := list_get(*stack, FRAME_ARGS)

    *env = env_create(car(op))
    arg_names := car(cdr(op))
    body = cdr(cdr(op))
    list_set(*stack, FRAME_ENV, *env)
    list_set(*stack, FRAME_BODY, body)

    // bind the arguments
    for !nilp(arg_names) {
        if arg_names._type == AtomType_Symbol {
            _ = env_set(*env, arg_names, args)
            args = _nil
            break
        } else if nilp(args) {
            // it is an error if we have too few arguments
            return Error_Args
        }
        _ = env_set(*env, car(arg_names), car(args))
        arg_names = cdr(arg_names)
        args = cdr(args)
    }
    if !nilp(args) {
        // it is an error if we have too many arguments
        return Error_Args
    }
    list_set(*stack, FRAME_ARGS, args)

    return eval_do_exec(stack, expr, env)
}

The next function is called once all arguments have been evaluated, and is responsible either generating an expression to call a builtin, or delegating to eval_do_bind.

// eval_do_apply is called once all arguments have been evaluated.
// it is responsible either generating an expression to call a builtin,
// or delegating to eval_do_bind.
func eval_do_apply(stack, expr, env, result *Atom) error {
    op := list_get(*stack, FRAME_OP)
    args := list_get(*stack, FRAME_ARGS)

    if !nilp(args) {
        list_reverse(&args)
        list_set(*stack, 4, args)
    }

    if op._type == AtomType_Symbol {
        if op.value.symbol.EqualString("APPLY") {
            // replace the current frame
            *stack = car(*stack)
            *stack = make_frame(*stack, *env, _nil)
            // update the op and args in the new frame
            op = car(args)
            list_set(*stack, FRAME_OP, op)
            if args = car(cdr(args)); !listp(args) {
                return Error_Syntax
            }
            list_set(*stack, FRAME_ARGS, args)
        }
    }

    // we must have a builtin or closure to continue
    if op._type == AtomType_Builtin {
        *stack = car(*stack)
        *expr = cons(op, args)
        return nil
    } else if op._type != AtomType_Closure {
        return Error_Type
    }

    return eval_do_bind(stack, expr, env)
}

This part is called once an expression has been evaluated, and is responsible for storing the result, which is either an operator, an argument, or an intermediate body expression, and fetching the next expression to evaluate.

// eval_do_return is called after an expression has been evaluated.
// is responsible for storing the result, which is either an operator,
// an argument, or an intermediate body expression, and fetching the
// next expression to evaluate.
func eval_do_return(stack, expr, env, result *Atom) error {
    var op, body, args, sym Atom

    *env = list_get(*stack, FRAME_ENV)
    op = list_get(*stack, FRAME_OP)
    body = list_get(*stack, FRAME_BODY)

    if !nilp(body) {
        // still running a procedure; ignore the intermediate result
        return eval_do_apply(stack, expr, env, result)
    }

    if nilp(op) {
        // finished evaluating operator
        op = *result
        list_set(*stack, 2, op)

        if op._type == AtomType_Macro {
            // don't evaluate macro arguments
            args = list_get(*stack, FRAME_TAIL)
            *stack = make_frame(*stack, *env, _nil)
            op._type = AtomType_Closure
            list_set(*stack, FRAME_OP, op)
            list_set(*stack, FRAME_ARGS, args)
            return eval_do_bind(stack, expr, env)
        }
    } else if op._type == AtomType_Symbol {
        // finished working on special form
        if op.value.symbol.EqualString("DEFINE") {
            sym = list_get(*stack, 4)
            _ = env_set(*env, sym, *result)
            *stack = car(*stack)
            *expr = cons(make_sym([]byte("QUOTE")), cons(sym, _nil))
            return nil
        } else if op.value.symbol.EqualString("IF") {
            args = list_get(*stack, FRAME_TAIL)
            if nilp(*result) {
                *expr = car(cdr(args))
            } else {
                *expr = car(args)
            }
            *stack = car(*stack)
            return nil
        }
        // store evaluated argument
        args = list_get(*stack, FRAME_ARGS)
        list_set(*stack, FRAME_ARGS, cons(*result, args))
    } else if op._type == AtomType_Macro {
        // finished evaluating macro
        *expr = *result
        *stack = car(*stack)
        return nil
    } else {
        // store evaluated argument
        args = list_get(*stack, FRAME_ARGS)
        list_set(*stack, FRAME_ARGS, cons(*result, args))
    }

    args = list_get(*stack, FRAME_TAIL)
    if nilp(args) {
        // no more arguments left to evaluate
        return eval_do_apply(stack, expr, env, result)
    }

    // evaluate next argument
    *expr = car(args)
    list_set(*stack, 3, cdr(args))
    return nil
}

And here we are at last with the new eval_expr. There is a lot of code for setting up special forms, but the rest is simply a loop waiting for the stack to clear.

// eval_expr evaluates an expression with a given environment and updates the result.
// much of the work is for setting up special forms; the rest is a loop to process
// then entire stack frame.
// note that the result may not be updated if we find errors.
func eval_expr(expr, env Atom, result *Atom) error {
    var stack Atom

    // do {...} while (!err);
    for {
        if expr._type == AtomType_Symbol {
            if err := env_get(env, expr, result); err != nil {
                return err
            }
        } else if expr._type != AtomType_Pair {
            *result = expr
        } else if !listp(expr) {
            return Error_Syntax
        } else {
            op, args := car(expr), cdr(expr)
            if op._type == AtomType_Symbol {
                // handle special forms
                if op.value.symbol.EqualString("QUOTE") {
                    // verify number and type of args
                    if nilp(args) || !nilp(cdr(args)) {
                        return Error_Args
                    }
                    *result = car(args)
                } else if op.value.symbol.EqualString("DEFINE") {
                    // verify number and type of args
                    if nilp(args) || nilp(cdr(args)) {
                        return Error_Args
                    }
                    if sym := car(args); sym._type == AtomType_Pair {
                        if err := make_closure(env, cdr(sym), cdr(args), result); err != nil {
                            return err
                        } else if sym = car(sym); sym._type != AtomType_Symbol {
                            return Error_Type
                        }
                        _ = env_set(env, sym, *result)
                        *result = sym
                    } else if sym._type == AtomType_Symbol {
                        if !nilp(cdr(cdr(args))) {
                            return Error_Args
                        }
                        stack = make_frame(stack, env, _nil)
                        list_set(stack, FRAME_OP, op)
                        list_set(stack, FRAME_ARGS, sym)
                        expr = car(cdr(args))
                        continue
                    } else {
                        return Error_Type
                    }
                } else if op.value.symbol.EqualString("LAMBDA") {
                    // verify number and type of args
                    if nilp(args) || nilp(cdr(args)) {
                        return Error_Args
                    }
                    if err := make_closure(env, car(args), cdr(args), result); err != nil {
                        return err
                    }
                } else if op.value.symbol.EqualString("IF") {
                    // verify number and type of args
                    if nilp(args) || nilp(cdr(args)) || nilp(cdr(cdr(args))) || !nilp(cdr(cdr(cdr(args)))) {
                        return Error_Args
                    }
                    stack = make_frame(stack, env, cdr(args))
                    list_set(stack, 2, op)
                    expr = car(args)
                    continue
                } else if op.value.symbol.EqualString("DEFMACRO") {
                    // verify number and type of args
                    if nilp(args) || nilp(cdr(args)) {
                        return Error_Args
                    } else if car(args)._type != AtomType_Pair {
                        return Error_Syntax
                    }
                    name := car(car(args))
                    if name._type != AtomType_Symbol {
                        return Error_Type
                    }
                    var macro Atom
                    if err := make_closure(env, cdr(car(args)), cdr(args), ¯o); err != nil {
                        return err
                    }
                    macro._type = AtomType_Macro
                    *result = name
                    _ = env_set(env, name, macro)
                } else if op.value.symbol.EqualString("APPLY") {
                    // verify number and type of args
                    if nilp(args) || nilp(cdr(args)) || !nilp(cdr(cdr(args))) {
                        return Error_Args
                    }
                    stack = make_frame(stack, env, cdr(args))
                    list_set(stack, FRAME_OP, op)
                    expr = car(args)
                    continue
                } else {
                    // push a new stack frame to handle function application
                    stack = make_frame(stack, env, args)
                    expr = op
                    continue
                }
            } else if op._type == AtomType_Builtin {
                if err := op.value.builtin.fn(args, result); err != nil {
                    return err
                }
            } else {
                // push a new stack frame to handle function application
                stack = make_frame(stack, env, args)
                expr = op
                continue
            }
        }

        // terminate this loop if we've exhausted the stack
        if nilp(stack) {
            return nil
        }

        // try storing the result and fetching the next expression from the stack
        if err := eval_do_return(&stack, &expr, &env, result); err != nil {
            return nil
        }
    }
}

Now that eval_expr implements APPLY, we can remove it from our default environment and also remove our apply and builtin_apply functions.

Testing

Let's try our COUNT function again.

> (count 100000)
100000

Hooray! We can now recurse as much as we like without causing a stack overflow. If you have a lot of RAM, you should even be able to do a million levels deep.

Tail recursion

If the last expression in a function is a call to another function, then the result can be returned directly to the first function's caller. This is known as a tail call. If the called function, through a series of tail calls, causes the first function to be called, we have tail recursion.

Tail calls do not require the caller's stack frame to be retained, so a tail-recursive function can recurse as many levels as necessary without increasing the stack depth.

The count function could be formulated as a tail-recursive procedure as follows:

(define (count n a)
  (if (= n 0)
      a
      (count (- n 1) (+ a 1))))

(count 100000 0)

If you watch eval_expr with a debugger you can confirm that the stack never grows above a few levels deep.

func TestChapter14(t *testing.T) {
    env := env_create_default()
    if err := load_file(env, "library.lisp"); err != nil {
        t.Errorf("error: want nil: got %v\n", err)
    }

    for _, tc := range []struct {
        id     int
        input  string
        expect string
        err    error
    }{
        {id: 1, input: "(define (count n) (if (= n 0) 0 (+ 1 (count (- n 1)))))", expect: "COUNT"},
        {id: 2, input: "(count 100000)", expect: "100000"},
        {id: 3, input: "(define (count n a) (if (= n 0) a (count (- n 1) (+ a 1))))", expect: "COUNT"},
        {id: 4, input: "(count 100000 0)", expect: "100000"},
    } {
        var expr Atom
        _, err := read_expr([]byte(tc.input), &expr)
        if err != nil {
            t.Errorf("%d: read error: want nil: got %v\n", tc.id, err)
            continue
        }

        var result Atom
        err = eval_expr(expr, env, &result)

        if tc.err == nil && err == nil {
            // yay
        } else if tc.err == nil && err != nil {
            t.Errorf("%d: error: want nil: got %v\n", tc.id, err)
        } else if !errors.Is(err, tc.err) {
            t.Errorf("%d: error: want %v: got %v\n", tc.id, tc.err, err)
        }
        if got := result.String(); tc.expect != got {
            t.Errorf("%d: eval: want %q: got %q\n", tc.id, tc.expect, got)
        }
    }
}