Lisp evaluator code

Here is a test case you can use to demonstrate your improved evaluator. It does not use def.

(finkel-eval '(((lambda (x) (function (lambda (y) (cons x y)))) 3) 4) nil)

You need to fix a minor bug in the evaluator so that the following yields (1 . 2):

(finkel-eval '(((lambda (x) ( lambda (y) (cons 1 2)) ) 3) 4) nil) ; (1 . 2)

Bill Dieter typed in the code for eval from the book, but had to make some changes to make it work. Here is what he ended up with. He renamed eval and apply to finkel-eval and finkel-apply so they will not conflict with the builtin eval and apply.

Note that the common lisp error function takes a string as a parameter rather than a symbol. He also added cases in eval for numbers, strings, and t. Without these cases, you cannot use numbers, strings, or t.


(defun finkel-eval (list env)       ; evaluate list in env
  (cond
   ((null list) nil)
   ((numberp list) list)        ; Dieter added this
   ((stringp list) list)        ; Dieter added this
   ((eq t list) list)           ; Dieter added this
   ((atom list) (lookup list env)) ; Raphael removed Lisp-1.5 code
   ((eq (car list) 'quote) (car (cdr list)))
   ((eq (car list) 'cond) (evalcond (cdr list) env))
   (t (finkel-apply (car list) (evallist (cdr list) env) env))))

(defun finkel-apply (fct parms env) ; apply fct to parms
  (cond
   ((atom fct) (cond
        ((eq fct 'car) (car (car parms)))
        ((eq fct 'cdr) (cdr (car parms)))
        ((eq fct 'cons) (cons (car parms) (car (cdr parms))))
        ((eq fct 'get) (get (car parms) (car (cdr parms))))
        ((eq fct 'atom) (atom (car parms)))
        ((eq fct 'error) (error (string parms)))
        ((eq fct 'eq) (eq (car parms) (car (cdr parms))))
        (t (cond
            ((get fct 'EXPR)
             (finkel-apply (get fct 'EXPR) parms env) parms env)
            (t (finkel-apply (lookup fct env) parms env))))))
   ((eq (car fct) 'lambda)
    (finkel-eval (car (cdr (cdr fct)))
      (update (car (cdr fct)) parms env)))
   (t (finkel-apply (finkel-eval fct env) parms env))))

(defun evalcond (conds env)     ;evaluate cond
  (cond
   ((null conds) nil)
   ((finkel-eval (car (car conds)) env)
    (finkel-eval (car (cdr (car conds))) env))
   (t (evalcond (cdr conds) env))))

(defun evallist (list env)      ;evaluate list
  (cond
   ((null list) nil)
   (t (cons (finkel-eval (car list) env)
        (evallist (cdr list) env)))))

(defun lookup (id env)          ; lookup id
  (cond
   ((null env) (error "Unbound variable: ~S" id))
   ((eq id (car (car env))) (car (cdr (car env))))
   (t (lookup id (cdr env)))))

(defun update (formals vals env)    ; bind parameters
  (cond
   ((null formals)
    (cond ((null vals) env)
      (t (error "bad argument count"))))
   ((null vals) (error "bad argument count"))
   (t (cons (cons (car formals)
          (cons (car vals) nil))
        (update (cdr formals) (cdr vals) env)))))