This page has been proofread, but needs to be validated.
Steele and Sussman
36
The Art of the Interpreter

(DEFINE (EVAL EXP ENV)
        (COND ((ATOM EXP)
               (COND ((NUMBERP EXP) EXP)
                     (T (VALUE EXP ENV))))
              ((EQ (CAR EXP) 'QUOTE)
               (CADR EXP))
              ((EQ (CAR EXP) 'LAMBDA)
               (LIST '&PROCEDURE (CADR EXP) (CADDR EXP) ENV))
              ((EQ (CAR EXP) 'SETQ)
               (EVSETQ (CADR EXP) (EVAL (CADDR EXP) ENV) ENV))
              ((EQ (CAR EXP) 'PROGN)
               (EVPROGN (CDR EXP) ENV NIL))
              ((EQ (CAR EXP) 'COND)
               (EVCOND (CDR EXP) ENV))
              (T (APPLY (EVAL (CAR EXP) ENV)
                        (EVLIS (CDR EXP) ENV)))))

(DEFINE (EVSETQ VAR VAL ENV)
        ((LAMBDA (SLOT)
                 (COND ((EQ SLOT '&UNBOUND)
                        (EV-TOP-LEVEL-SETQ VAR VAL ENV))
                       (T (CAR (RPLACA SLOT VAL)))))
         (LOOKUP VAR ENV)))

(DEFINE (EV-TOP-LEVEL-SETQ VAR VAL ENV)
        (COND ((NULL (CDR ENV))
               (CADAR (RPLACA ENV
                              (CONS (CONS VAR (CAAR ENV))
                                    (CONS VAL (CDAR ENV))))))
              (T (EV-TOP-LEVEL-SETQ VAR VAL (CDR ENV)))))

(DEFINE (EVPROGN EXPS ENV HUNOZ)
        (COND ((NULL (CDR EXPS)) (EVAL (CAR EXPS) ENV))
              (T (EVPROGN (CDR EXPS) ENV (EVAL (CAR EXPS) ENV)))))

For VALUE, LOOKUP, and BIND see Figure 3.
For EVCOND and EVLIS see Figure 5.
For APPLY see Figure 7.
For LOOKUP1 see Figure 10 (not Figure 3).

Figure 11
Evaluator with User Side Effects (Assignment to Variables)