Recitation 15

Today's Ideas:
-- recursive evaluation of expressions
-- global environments
-- evaluating BASIC

---

Part 1: Expression Evaluation

We noted that we could evaluate simple sums

    (eval-expr '(1 + 2))

and nested sums

    (eval-expr '(1 + (2 + 3)))

We drew an abstract syntax tree for this kind of expression and talked about the idea of recursive evaluation. There are two kinds of expressions, sums and numbers, and the evaluator simply returns a number and calls itself recursively for a sum, adding the results. I pointed out that all the programming work is actually in the procedures that determine what an expression is and break it into parts -- boring but essential stuff. We discussed why you couldn't just order the checks in the cond statement with an else in place of the sum? test.
We want

    (eval-expr '(1 1))

to signal an appropriate error.

We noted that of course a number is an expression to, so we can do

    (eval-expr 34)

and (to my surprise) this surprised some of you.

The second crucial aspect of the expression evaluator was binding of names. We noted that

  (eval-expr '(x + 2))

threw an error ("unbound variable"), but gave 5 after we first executed

  (table-put! environment 'x 3)

I pointed out that we have a simple notion of binding here -- a single, global environment -- and promised that in lecture on Thursday you'd see real environments.

Finally, we noted that the expression evaluator handles one kind of test: a comparison of two numbers, so

    (eval-expr '(4 > 3))

gives #t.

Part 2: Statement Evaluation

 '(
  (x = 0)
  (LOOP : x = (x + 1))
  (print (x + x))
  (if (10 > x) goto LOOP)
  )

2
4
6
8
10
12
14
16
18
20
done

    print <expr>

an assignment statement of the form

    <var> = <expr>

and an if statement of the form

    if <test-expr> goto <label>

and that each statement can have an optional label and semicolon at the front.

I told you to assume that you had all the boring utility procedures you needed, and showed you some of these working:

> (assign? '(print 3))
#f

> (assign? '(x = 3))
#t

> (assign-var '(x = 3))
x

> (assign-expr '(x = 3))
3

-- the top-level evaluator takes a list of statements
-- if the list is empty, it prints done
-- otherwise, it evaluates the first, then calls itself recursively on the rest

To evaluate a statement, we simply use the expression evaluator. An assignment, for example, is handled by expression-evaluating the expression, then doing a table-put! to bind the name to that value in the environment.

Then you thought about labels.

Several of you came up with a clever idea. When you see a statement list starting with a statement that is labelled, you insert into the environment a binding of that label to that list. This is elegant, but has two problems:

1. You can't use a label name that is also a variable name. This could be fixed by having separate label and variable environments.

2. A bigger snag -- you can't handle an if-statement that jumps to a label that hasn't yet been encountered. To fix this, you need to pass over the program in advance and prepare a table that binds labels to statement lists.

The code below shows how to do this. Note that I've used a data abstraction to represent the program state. It combines in a single abstract object the label table and the current statement list (representing essentially the program counter). Its operations are:

    end? : ProgramState -> Bool                                        ; returns true if there are no more statements to execute
    next-state : ProgramState -> ProgramState                ; returns the state corresponding to a single step
    lookup-label : ProgramState, Label -> ProgramState  ; returns the state following a goto to the given label

Definitions

(define (sum? e)
  (and (pair? e) (pair? (cdr e)) (eq? (cadr e) '+)))
(define (greater? e)
  (and (pair? e) (pair? (cdr e)) (eq? (cadr e) '>)))

(define (eval-greater exp)
  (> (eval-expr (car exp)) (eval-expr (caddr exp))))

(define (eval-sum exp)
   (+ (eval-expr (car exp)) (eval-expr (caddr exp))))

(define (eval-expr exp)
  (cond
   ((number? exp) exp)
   ((sum? exp)    (eval-sum exp))
   ((symbol? exp) (lookup exp))
   ((greater? exp) (eval-greater exp))
   (else
    (error "unknown expression " exp))))

(define environment (make-table))

(define (lookup name)
  (let ((binding (table-get environment name)))
    (if binding
        (binding-value binding)
        (error "unbound variable: " name))))

; STATEMENT EVALUATOR

; evaluate from a program state ps
(define (eval ps)
  (if (end? ps)
      (display 'done)
      (let ((stmt (first-stmt ps)))
        (cond ((print? stmt) (display (eval-expr (print-expr stmt))) (newline))
              ((assign? stmt)
                 (table-put! environment
                             (assign-var stmt)
                             (eval-expr (assign-expr stmt)))))
        (cond ((and (if? stmt) (eval-expr (if-test stmt)))
                 (eval (lookup-label ps (if-label stmt))))
              (else (eval (next-state ps)))))))

; BASIC PROGRAM STATE DATA ABSTRACTION

; a program state is represented as a pair
; the car part is a table mapping labels to lists
; where the first element in the list for label X is the statement labelled X,
; and the second element is the statement following that one, etc.
; the car part is a list of statements starting at the next to be executed

;; return the program state after executing current statement
(define (next-state ps) (cons (car ps) (cddr ps)))

;; return the statement about to be executed
(define (first-stmt ps) (cadr ps))

;; return the program state resulting from a goto to label
(define (lookup-label ps label)
  (let ((result (table-get (car ps) label)))
    (if result
        (cons (car ps) (binding-value result))
        (error "no such label" label))))

(define (end? ps) (null? (cdr ps)))

;; take program text p consisting of a list of statements
;; and return the program state corresponding to the initial state
(define (text-to-initial-state pgm)
  (let ((table (make-table)))
    (insert-label-entries table pgm)
    (cons table pgm)))

(define (insert-label-entries table pgm)
  (if (null? pgm)
      table
      (begin
        (insert-label-entry table (car pgm) pgm)
        (insert-label-entries table (cdr pgm)))))

(define (insert-label-entry table s pgm)
  (if (stmt-labelled? s)
      (table-put! table (stmt-label s) pgm)))

;; Boring, but necessary

(define (stmt-labelled? s)
  (and (pair? s)
       (pair? (cdr s))
       (eq? (cadr s) ':)))

(define (strip-label s) (cddr s))
(define (stmt-label s) (car s))
(define (apply-to-stripped proc)
  (lambda (stmt)
    (if (stmt-labelled? stmt)
        ((apply-to-stripped proc) (strip-label stmt))
        (proc stmt))))

(define print?
  (apply-to-stripped
   (lambda (s)(and (pair? s) (eq? (car s) 'print)))))
(define assign?
  (apply-to-stripped
   (lambda (s)(and (pair? s) (pair? (cdr s)) (eq? (cadr s) '=)))))
(define if?
  (apply-to-stripped
   (lambda (s)(and (pair? s) (eq? (car s) 'if)))))

(define print-expr
  (apply-to-stripped
   (lambda (s)(cadr s))))
(define assign-var
  (apply-to-stripped
   (lambda (s)(car s))))
(define assign-expr
  (apply-to-stripped
   (lambda (s)(caddr s))))
(define if-test
  (apply-to-stripped
   (lambda (s)(cadr s))))
(define if-label
  (apply-to-stripped
   (lambda (s)(cadddr s))))

Definitions used

(define table-tag 'table)
(define (make-table) (cons table-tag '()))
(define (tag-check e sym) (and (pair? e) (eq? (car e) sym)))
(define (table? x) (tag-check x table-tag))

(define (add-assoc key val alist) (cons (list key val) alist))

(define (table-put! tbl key val)
  (set-cdr! tbl (add-assoc key val (cdr tbl))))
(define (table-get tbl key)
  (assq key (cdr tbl)))
(define binding-value cadr)