Tail Recursion with Dynamic Scope

[This revision of a comp.lang.scheme article assumes you're fluent in Lisp and have a basic acquaintance with tail recursion and dynamic scoping of variables. The three go together in a nonobvious enough way that even Guy Steele could get it wrong [Steele77]: ``In most LISP systems, which use dynamic scoping rather than lexical, tail-recursion is impossible because function calls must push control stack in order to be able to undo the dynamic bindings after the return of the function.'']

The Problem

Tail-call optimization replaces code sequences like

        CALL foo
        RETURN
with
        GOTO foo.
When applied throughout a program, this transforms tail recursions into loops; many modern languages exploit this fact by providing no explicit iteration constructs, instead letting you express control flow with procedure calls.

The most natural way to interpret a dynamically-scoped language, however, generally has code between the CALL and the RETURN, spoiling the optimization. We'll start with a simple interpreter that shows the problem:

(define (eval-exp exp)
  (cond
    ((symbol? exp)            (get-variable-value exp))
    ((not (pair? exp))        exp)
    ((eq? (car exp) 'quote)   (cadr exp))
    ((eq? (car exp) 'lambda)  exp)
    ((eq? (car exp) 'if)
     (if (eval-exp (cadr exp))
         (eval-exp (caddr exp))
         (eval-exp (cadddr exp))))
    ((eq? (car exp) 'begin)
     (eval-exp (cadr exp))
     (eval-exp (caddr exp)))
    (else
     (apply-proc (eval-exp (car exp))
                 (map eval-exp (cdr exp))))))

(define (apply-proc proc args)
  (cond
    ((procedure? proc)        ; we represent primitives by Scheme procedures
     (apply proc args))
    ((and (pair? proc) (eq? (car proc) 'lambda))
     (push-frame! (cadr proc) args)
     (let ((result (eval-exp (caddr proc))))
       (pop-frame!)           ;** This line's the fly in the ointment.
       result))))
where (push-frame! variables values) saves the old bindings of variables and replaces them with values, and (pop-frame!) restores the old bindings. (See Appendix B for auxiliary definitions and test code.) Unfortunately, we have to pop the frame after the recursive call to eval-exp, moving it out of tail position.

A First Attempt

It's not hard to get rid of that inconvenient pop-frame!: simply shift elsewhere the responsibility for restoring bindings. We split eval-exp into two cases: eval-tail for the expressions in tail position, and eval-head for the rest. Eval-head restores the environment after it's done so that eval-tail and apply-proc don't have to.

(define (eval-tail exp)                             ;** (changed)
  (cond
    ((symbol? exp)            (get-variable-value exp))
    ((not (pair? exp))        exp)
    ((eq? (car exp) 'quote)   (cadr exp))
    ((eq? (car exp) 'lambda)  exp)
    ((eq? (car exp) 'if)
     (if (eval-head (cadr exp))                     ;**
         (eval-tail (caddr exp))                    ;**
         (eval-tail (cadddr exp))))                 ;**
    ((eq? (car exp) 'begin)
     (eval-head (cadr exp))                         ;**
     (eval-tail (caddr exp)))                       ;**
    (else
     (apply-proc (eval-head (car exp))              ;**
                 (map eval-head (cdr exp))))))      ;**

(define (apply-proc proc args)
  (cond
    ((procedure? proc)
     (apply proc args))
    ((and (pair? proc) (eq? (car proc) 'lambda))
     (bind-variables! (cadr proc) args)             ;**
     (eval-tail (caddr proc)))))                    ;**

(define (eval-head exp)                             ;**
  (save-env)                                        ;**
  (let ((result (eval-tail exp)))                   ;**
    (restore-env)                                   ;**
    result))                                        ;**
where save-env saves the current environment, restore-env restores it, and bind-variables! extends it. Now all tail calls in the program being interpreted will be evaluated by tail calls in the interpreter. Are we done? Well, no.

Buried Bindings

The obvious code for the environment keeps a stack of saved bindings, pushing and popping them as needed:

(define stack '(()))                 ; start with one empty frame

(define (save-env)
  (set! stack (cons '() stack)))

(define (bind-variables! variables values)
  (for-each
    (lambda (variable value)
      (set-car! stack
                (cons (cons variable (get-variable-value variable))
                      (car stack)))
      (set-variable-value! variable value))
    variables
    values))

(define (restore-env)
  (for-each (lambda (pair)
              (set-variable-value! (car pair) (cdr pair)))
            (car stack))
  (set! stack (cdr stack)))

This shows up the real difficulty in combining tail recursion with dynamic scope: the stack grows whenever a variable is bound, which is on every call to a procedure with arguments - even a tail call. For instance, calling count-up, below, quickly exhausts all of memory.

(set-variable-value! 'count-up
  '(lambda (n)
     (begin (write n)
            (count-up (+ n 1)))))

(eval-tail '(count-up 0))

How can we avoid this stack growth? We only need to be able to restore the environment to the points where save-env was called. If a variable is rebound multiple times between one save-env call and another, we don't need to save its binding each time; the first binding is all we need. The other bindings are buried [Baker92]. Let's look at an example that actually terminates:

(set-variable-value! 'count-down
  '(lambda (n)
     (begin (write n)
            (if (= n 0)
                'done
                (count-down (- n 1))))))

(set-variable-value! 'n 'initial-value)

(eval-head '(count-down 1000))
Each tail-recursive call buries the old binding of n; only initial-value needs to be saved. (If you're thinking ``Okay, don't save bindings on tail calls'', it's not that easy. Appendix A shows one case where that won't work.)

A simple solution, then, is to keep a list of the variables saved since the last save-env call, checking against the list each time we rebind a variable. The code is almost identical:

(define stack '(()))

(define (save-env)
  (set! stack (cons '() stack)))

(define (bind-variables! variables values)
  (for-each
    (lambda (variable value)
      (if (not (assq variable (car stack)))             ;** changed
          (set-car! stack
                    (cons (cons variable (get-variable-value variable))
                          (car stack))))
      (set-variable-value! variable value))
    variables
    values))

(define (restore-env)
  (for-each (lambda (pair)
              (set-variable-value! (car pair) (cdr pair)))
            (car stack))
  (set! stack (cdr stack)))

This handles arbitrarily complicated chains of tail calls correctly because now a stack frame can't have more entries than the program has variables.

Improving Efficiency

Searching the stack frame each time you rebind a variable can be slow, though usually the frame is small. You can avoid the search by giving each variable an auxiliary flag telling whether it's in the current frame. (Saving and restoring this flag properly is left as an exercise to the reader. The overhead can be reduced a little using a counter instead of a flag; see my comp.lang.scheme post for details.)

Another approach [Baker92] skips the check completely, instead letting the garbage collector remove buried bindings.

Compiling this scheme would be somewhat nasty because it's statically undecidable which variables will occupy a frame. That is, our original interpreter has an equivalent compiler with very efficient procedure entry/exit code, saving and restoring a known set of variables, where our final interpreter must loop over a set built up at runtime. It may make sense to specialize procedure entry points based on analysis of the frames at different call sites.

References

Appendix A: Why tail recursion matters

In this article I wasn't satisfied until I could execute an arbitrary chain of tail calls in a bounded amount of space. Should real programmers care, or only computer scientists? It would've been easy to hack up a fix for the simple kind of tail recursion displayed by count-up and count-down; C compilers that advertise tail-recursion elimination rarely do much more. I think it does matter quite a bit, and it's easiest to explain why with an example.

The Lisp reader is table-driven. Its main loop reads a character and dispatches to the character's handler:

(define (read port)                     ; (simplified version)
  (let ((char (read-char port)))
    ((vector-ref *readtable* (char->integer char))
     char
     port)))

(define (install-read-macro char handler)
  (vector-set! *readtable* (char->integer char) handler))

Now for some handlers. For example, 'x should expand to (quote x):

(install-read-macro #\'
  (lambda (char port) (list 'quote (read port))))

Whitespace characters get skipped:

(for-each (lambda (char)
            (install-read-macro char (lambda (char port) (read port))))
          '(#\space #\tab #\newline))

Already the importance of proper tail recursion is clear. Without it, to read past a string of spaces the interpreter enters into a deep mutual recursion between read's main loop and the whitespace handler, before it can even start reading what comes after. (Note that the stack isn't popped until after what comes after. Also note this is a mutual recursion between procedures not determined at compile time.) We can either live with the inefficiency, complicate the interface between read and the handlers, give up and consolidate everything into a monolithic procedure - or agree that proper tail recursion is the Right Thing.

Table-driven procedures like this one are not terribly exotic; they have much in common with OOP. Mutual recursion is hardly rare either, showing up also in eval-exp and apply-proc right in this article. By nature, All Control Flow Is One, and unnaturally dividing it eviscerates programs. Let this be your mantra. If you still lack faith, ponder the Windows event loop.

Appendix B: Support code

Accessing the current variable bindings:

(define bindings '())

(define (get-variable-value variable)
  (cond ((assq variable bindings) => cdr)
        (else #f)))

(define (set-variable-value! variable value)
  (cond ((assq variable bindings) => (lambda (pair) (set-cdr! pair value)))
        (else (set! bindings (cons (cons variable value) bindings)))))

Environment operations for the non-tail-recursive interpreter:

(define stack '())

(define (push-frame! variables values)
  (set! stack (cons (cons variables (map get-variable-value variables))
                    stack))
  (for-each set-variable-value! variables values))

(define (pop-frame!)
  (for-each set-variable-value! (caar stack) (cdar stack))
  (set! stack (cdr stack)))

Setup for the examples:

(set-variable-value! 'write write)
(set-variable-value! '+ +)
(set-variable-value! '- -)
(set-variable-value! '= =)

Home   |   © 1994-2003 by Darius Bacon