Interpreters

Advanced Methods in Programming Languages (201-2-4411-01)
Notes Week 6 - Michael Elhadad

A Continuation-based Interpreter

Control Context

The control context determines what will happen after a computation step has been performed. Up to now, the interpreters we have written, maintain a control context implicitly: each time a sub-expression of a program is evaluated, the interpreter "knows" what is the next step to compute because the interpreter is written in a recursive meta-language. The state of the interpreter in an implicit representation of the control context of the object program.

In this chapter, we want to make the control context explicit. To this end, we introduce a continuation as an argument to the interpreter.

Consider the classic example of a recursive computation in Scheme:

(define fact
  (lambda (n)
    (if (= n 0)
      1
      (* n (fact (- n 1))))))

Using the substitution model, we can model a computation of fact as a derivation of the following steps:

  (fact 3)
= (* 3 (fact 2))
= (* 3 (* 2 (fact 1)))
= (* 3 (* 2 (* 1 (fact 0))))
= (* 3 (* 2 (* 1 1)))
= (* 3 (* 2 1))
= (* 3 2)
= 6

As seen in this derivation, fact is called in larger and larger control contexts (because the recursive invocation of fact occurs in a non tail position). This is in contrast to an iterative definition of fact:

(define fact-iter
  (lambda (n acc)
    (if (= n 0)
      acc
      (fact-iter (- n 1) (* n acc)))))

  (fact-iter 3 1)
= (fact-iter 2 3)
= (fact-iter 1 6)
= (fact-iter 0 6)
= 6

In this derivation, the control context never grows. This is typical of iterative behavior.

Note that syntactically, both procedures fact and fact-iter are "recursive" in the sense that they "call themselves". But the behavior of fact is recursive because it consumes control context (it requires memory to keep track of the unfinished computations), while fact-iter is iterative in behavior. (Note that fact-iter transcribed in C++ or Java would not have iterative behavior because the compilers of these languages do not in general perform the last call optimization).

In general, control context is consumed each time complex actual parameters must be computed in the context of an application.

Introduction to Continuation Passing Style (CPS)

In the new interpreter, we add a new parameter, called a continuation, which is an abstraction of the control context in which each sub-expression is evaluated.

In our model, an environment is a function from symbols to locations in a store. A continuation is a function which takes the result of the computation step as an argument and completes the computation. The ADT for continuations is similar to the one of environment:

contructors (the list will be provided later)
apply-cont(cont, expval) --> expval

The strategy we follow consists of applying the CPS transformation on the interpreter for our object language. We then obtain a new version of the interpreter with an explicit continuation parameter.

;; Original interpreter
(define eval-program
  (lambda (pgm)
    (cases program pgm
      (a-program (body)
        (eval-exp body (init-env))))))

(define eval-exp
  (lambda (exp env)
    (cases expression exp
      (lit-exp (datum) datum)
      (var-exp (id) (apply-env env id))
      (proc-exp (ids body) (closure ids body env))
      (letrec-exp (proc-names idss bodies letrec-body)
        (eval-exp letrec-body
          (extend-env-recursively proc-names idss bodies env)))
      (if-exp (test-exp then-exp else-exp)
        (if (true-value? (eval-exp test-exp env))
          (eval-exp then-exp env)
          (eval-exp else-exp env)))
      (primapp-exp (prim rands)
        (let ((args (eval-rands rands env)))
          (apply-primitive prim args)))
      (app-exp (rator rands)
        (let ((proc (eval-exp rator env))
              (args (eval-rands rands env)))
          (if (procval? proc)
            (apply-proc proc args)
            (error "Attempt to apply non-procedure"))))
      (let-exp (ids rands body)
        (let ((args (eval-rands rands env)))
          (eval-exp body (extend-env ids args env))))
      (varassign-exp (id rhs-exp)
        (begin
          (setref! (apply-env-ref env id)
                   (eval-exp rhs-exp env))
          1))
      )))

(define eval-rands
  (lambda (rands env)
    (map (lambda (rand) (eval-exp rand env)) rands)))

(define apply-proc
  (lambda (proc args)
    (cases proc proc
      (a-closure (body formals c-env)
        (eval-exp body (extend-env c-env formals args))))))

For the transformation to CPS, we always ask the question: "which sub-expression is computed first" in a composite expression. The CPS transformation extracts the first subexpression and places it "first" in the chain of evaluation in CPS style. The resulting interpreter appears below. Note that in this transformation, we consider all environment manipulation as a primitive operation.

;; CPS interpreter - procedural continuations
(define eval-program
  (lambda (pgm)
    (cases program pgm
      (a-program (body)
        (eval-exp body (init-env) (halt-cont))))))

(define apply-cont
  (lambda (cont val) (cont val)))

(define halt-cont
  (lambda (val) (begin (write val) (newline))))

(define eval-exp
  (lambda (exp env cont)
    (cases expression exp
      (lit-exp (datum) (apply-cont cont datum))
      (var-exp (id) (apply-cont cont (apply-env env id)))
      (proc-exp (ids body) (apply-cont cont (closure ids body env)))
      (letrec-exp (proc-names idss bodies letrec-body)
        (eval-exp letrec-body
          (extend-env-recursively proc-names idss bodies env)
          cont))
      (if-exp (test-exp then-exp else-exp)
        (eval-exp test-exp env
          (lambda (test-val)
            (if (true-val? test-val)
              (eval-exp then-exp env cont)
              (eval-exp else-exp env cont)))))
      (primapp-exp (prim rands)
        (eval-rands rands env
          (lambda (args)
            (apply-cont cont (apply-primitive prim args)))))
      (app-exp (rator rands)
        (eval-exp rator env
          (lambda (proc)
            (eval-rands rands env
              (lambda (args)
                (if (procval? proc)
                  (apply-proc proc args cont)
                  (error "Attempt to apply non-procedure")))))))
      (let-exp (ids rands body)
        (eval-rands rands env
          (lambda (args)
            (eval-exp body (extend-env ids args env) cont))))
      (varassign-exp (id rhs-exp)
        (eval-exp rhs-exp env
          (lambda (rhs-val)
            (begin
              (setref! (apply-env-ref env id) rhs-val)
              (apply-cont cont 1)))))
      )))

(define eval-rands
  (lambda (rands env cont)
    (if (null? rands)
      (apply-cont cont '())
      (eval-exp (car rands) env
        (lambda (car-arg)
          (eval-rands (cdr rands) env
            (lambda (cdr-args)
              (apply-cont cont (cons car-arg cdr-args)))))))))

(define eval-proc
  (lambda (proc args cont)
    (cases proc proc
      (a-closure (body formals c-env)
        (eval-exp body
          (extend-env c-env formals args)
          cont)))))

A record-based Implementation of Continuations

The resulting CPS interpreter executes in Scheme as an iterative process. That is, we succeeded to evaluate a recursive object language program using an iterative process. We rely here on 2 strong properties of Scheme as a meta-language:

First class procedures for the procedural implementation of continuations
Tail recursion: Scheme insures that any tail-recursive procedure will be executed as an iterative process.

These 2 properties are not provided by other meta-languages (for example Java or C++). To make the implementation independant of the procedural representation of continuations, we can transform the continuation ADT into a record-based implementation.

This strategy is implemented as follows:

All places where a continuation is constructed, we define a new sub-type of the continuation type.
The body of the continuation becomes the case for apply-cont for the corresponding sub-type.

This results in the following definition:

;; CPS interpreter - record-based continuations
(define eval-program
  (lambda (pgm)
    (cases program pgm
      (a-program (body)
        (eval-exp body (init-env) (halt-cont))))))

(define eval-exp
  (lambda (exp env cont)
    (cases expression exp
      (lit-exp (datum) (apply-cont cont datum))
      (var-exp (id) (apply-cont cont (apply-env env id)))
      (proc-exp (ids body) (apply-cont cont (closure ids body env)))
      (letrec-exp (proc-names idss bodies letrec-body)
        (eval-exp letrec-body
          (extend-env-recursively proc-names idss bodies env)
          cont))
      (if-exp (test-exp then-exp else-exp)
        (eval-exp test-exp env
          (test-cont then-exp else-exp env cont)))
      (primapp-exp (prim rands)
        (eval-rands rands env
          (prim-args-cont prim cont)))
      (app-exp (rator rands)
        (eval-exp rator env
          (proc-cont rands env cont)))
      (let-exp (ids rands body)
        (eval-rands rands env
          (args-cont body ids env cont)))
      (varassign-exp (id rhs-exp)
        (eval-exp rhs-exp env
          (rhs-val-cont env id cont)))
      )))

(define eval-rands
  (lambda (rands env cont)
    (if (null? rands)
      (apply-cont cont '())
      (eval-exp (car rands) env
        (car-rands-cont rands env cont)))))

(define eval-proc
  (lambda (proc args cont)
    (cases proc proc
      (a-closure (body formals c-env)
        (eval-exp body
          (extend-env c-env formals args)
          cont)))))


;; ============================================================
;; Record-based continuation ADT
(define-datatype cont cont?
  (halt-cont)
  (test-cont (then-exp expression?)
             (else-exp expression?)
             (env env?)
             (cont cont?))
  (prim-args-cont (prim prim?)
                  (cont cont?))
  (proc-cont (rands (list-of expression?))
             (env env?)
             (cont cont?))
  (args-cont (body expression?)
             (ids (list-of symbol?))
             (env env?)
             (cont cont?))
  (rhs-val-cont (env env?)
                (id symbol?)
                (cont cont?))
  (car-rands-cont (rands (list-of expression?))
                  (env env?)
                  (cont cont?))
  (proc-args-cont (proc procval?)
                  (cont cont?))
  )

(define apply-cont
  (lambda (k val)
    (cases cont k
      (halt-cont () (begin (write val) (newline)))
      (test-cont (then-exp else-exp env cont)
        (if (true-val? val)
          (eval-exp then-exp env cont)
          (eval-exp else-exp env cont)))
      (prim-args-cont (prim cont)
        (apply-cont cont (apply-primitive prim val)))
      (proc-cont (rands env cont)
        (eval-rands rands env (proc-args-cont val cont)))
      (args-cont (body ids env cont)
        (eval-exp body (extend-env ids args env) cont))
      (rhs-val-cont (id env cont)
        (begin (setref! (apply-env-ref env id) val)
               (apply-cont cont 1)))
      (car-rands-cont (rands env cont)
        (eval-rands (cdr rands) env (cdr-rands-cont val cont)))
      (proc-args-cont (proc cont)
        (if (procval? proc)
          (apply-proc proc val cont)
          (error "Attempt to apply non-procedure")))
      (cdr-rands-cont (car-args cont)
        (apply-cont cont (cons car-args val)))
    )))

This implementation can be translated to a language that does not support first-class procedures. Note that the continuation record datatype is a sort of linked-list -- every non terminal continuation (that is every continuation subtype except halt-cont) contains a field "cont" which can be interpreted as "the next continuation in the stack". That is, continuations are stacked in a last-in first-out discipline. This datatype is completely similar to the runtime stack of activation frames that we have met in compilation.

A Register-based CPS Interpreter

The intepreter implementation above remains recursive in languages that do not enforce the last-call optimization (that is, languages that do not turn tail-calls into a simple jump without push). In these languages a procedure call even in tail position results in a growing control context.

In this section, we now introduce a register-based transformation which can be implemented in imperative languages as an iterative process.

The program transformation we apply to the CPS interpreter is a general transformation called the register-CPS transformation. It is based on the observation that if a group of procedures call each other only by tail calls, then we can translate the calls to use assignment instead of binding, and we can translate procedure invocation with a jump.

The first step is to list the procedures which will now communicate via shared registers instead of parameter passing:

(eval-exp exp env cont)
(eval-rands rands env cont)
(apply-proc proc args cont)
(apply-cont cont val)

We therefore introduce 7 global registers:

exp
env
cont
rands
proc
args
val

The procedures are now replaced with 0-argument procedures, and the calls to the procedures is replaced by code that stores the value of each actual parameters in the corresponding register and then invokes the new 0-argument procedure. For example:

(define eval-exp
  (lambda (exp env cont)
    (cases expression exp
      (lit-exp (datum) (apply-cont cont datum))
      ...)))

can be replaced by:

(define eval-exp
  (lambda ()
    (cases expression exp
      (lit-exp (datum)
        (set! cont cont)
        (set! val datum)
        (apply-cont))
      ...)))

In the systematic transformation, we deal with 3 specific cases:

If a register is unchanged from one procedure invocation to another, we drop the assignment. For example, (set! cont cont) can be removed.

When a field name of a data type is the same as a register name, the field hides the registers, and the registers becomes inaccessible. For example:

    (cases program pgm
      (a-program (exp)
        (eval-expression exp (init-env) (halt-cont))))

exp is locally bound and hides the global register exp. In this case, we rename the local variable:

    (cases program pgm
      (a-program (exp1)
        (eval-expression exp1 (init-env) (halt-cont))))

And we obtain:

    (cases program pgm
      (a-program (exp1)
        (set! exp exp1)
        (set! env (init-env))
        (set! cont (halt-cont))
        (eval-expression)))

If the same parameter appears twice in an argument list, we must take care of side effects:
```
    ;; Consider:
    (define f (lambda (x y) ...))
    ;; and the invocation:
    (f (+ x y) x)
    
```
Could be transformed into:
```
    (begin
      (set! x (+ x y))
      (set! y x)
      (f))
    
```
But this is incorrect, because y receives the new value of x instead of the old one. In this case, we must introduce temporary variables.

The resulting interpreter can be implemented as an iterative process in imperative languages without first-class procedures:

(define exp   'uninitialized)
(define env   'uninitialized)
(define cont  'uninitialized)
(define rands 'uninitialized)
(define val   'uninitialized)
(define proc  'uninitialized)
(define args  'uninitialized)

(define eval-program
  (lambda (pgm)
    (cases program pgm
      (a-program (exp1)
        (set! exp exp1)
        (set! env (init-env))
        (set! cont (halt-cont))
        (eval-exp)))))

(define eval-exp
  (lambda ()
    (cases expression exp
      (lit-exp (datum)
        (set! val datum)
        (apply-cont))
      (var-exp (id)
        (set! val (apply-env env id))
        (apply-cont))
      (proc-exp (ids body)
        (set! val (closure ids body env))
        (apply-cont))
      (letrec-exp (proc-names idss bodies letrec-body)
        (set! exp letrec-body)
        (set! env (extend-env-recursively proc-names idss bodies env))
        (eval-exp))
      (if-exp (test-exp then-exp else-exp)
        (set! exp test-exp)
        (set! cont (test-cont then-exp else-exp env cont))
        (eval-exp))
      (varassign-exp (id rhs-exp)
        (set! exp rhs-exp)
        (set! cont (rhs-val-cont env id cont))
        (eval-exp))
      (primapp-exp (prim rands1)
        (set! cont (prim-args-cont prim cont))
        (set! rands rands1)
        (eval-rands))
      (let-exp (ids rands1 body)
        (set! rands rands1)
        (set! cont (let-exp-cont ids env body cont))
        (eval-rands))
      (app-exp (rator rands)
        (set! exp rator)
        (set! cont (rator-cont rands env cont))
        (eval-exp))
      )))

(define eval-rands
  (lambda ()
    (if (null? rands)
      (begin
        (set! val '())
        (apply-cont))
      (begin
        (set! exp (car rands))
        (set! cont (car-rands-cont rands env cont))
        (eval-exp)))))

(define apply-cont
  (lambda ()
    (cases cont cont
      (halt-cont () (begin (write val) (newline)))
      (test-cont (then-exp else-exp env1 cont1)
        (if (true-val? val)
          (begin
            (set! exp then-exp)
            (set! env env1)
            (set! cont cont1)
            (eval-exp))
          (begin
            (set! exp else-exp)
            (set! env env1)
            (set! cont cont1)
            (eval-exp))))
      (prim-args-cont (prim cont1)
        (begin
          (set! cont cont1)
          (set! val (apply-primitive prim val))
          (apply-cont)))
      (proc-cont (rands1 env1 cont1)
        (begin
          (set! rands rands1)
          (set! env env1)
          (set! cont (proc-args-cont val cont1))
          (eval-rands)))
      (args-cont (body ids env1 cont1)
        (begin
          (set! exp body)
          (set! env (extend-env ids val env))
          (eval-exp)))
      (rhs-val-cont (id env1 cont1)
        (begin
          (setref! (apply-env-ref env id) val)
          (set! cont cont1)
          (set! env env1)
          (apply-cont)))
      (car-rands-cont (rands1 env1 cont1)
        (begin
          (set! env env1)
          (set! cont (cdr-rands-cont val cont1))
          (set! rands (cdr rands1))
          (eval-rands)))
      (proc-args-cont (proc1 cont1)
        (begin
          (if (procval? proc)
            (begin
              (set! proc proc1)
              (set! args val)
              (set! cont cont1)
              (apply-proc))
            (error "Attempt to apply non-procedure"))))
      (cdr-rands-cont (car-args cont1)
        (begin
          (set! cont cont1)
          (set! val (cons car-args val))
          (apply-cont)))
    )))


(define apply-proc
  (lambda ()
    (cases proc proc
      (closure (ids body env1)
        (begin
          (set! exp body)
          (set! env (extend-env env1 ids args))
          (eval-exp))))))

Last modified Apr 1, 2003 Michael Elhadad