lisp15.lisp

(defun lapply (fn x a)
  (cond ((atom fn) (cond ((eq fn 'car) (caar x))
                         ((eq fn 'cdr) (cdar x))
                         ((eq fn 'cons) (cons (car x) (cadr x)))
                         ((eq fn 'atom) (atom (car x)))
                         ((eq fn 'eq) (eq (car x) (cadr x)))
                         ((eq fn 'read) (read))
                         (t (lapply (leval fn a) x a))))
        ((eq (car fn) 'lambda) (leval (caddr fn) (pairlis (cadr fn) x a)))
        ((eq (car fn) 'label) (lapply (caddr fn) (cons (cons (cadr fn)
                                                             (caddr fn))
                                                       a)))))

(defun leval (e a)
  (cond ((atom e) (cdr (assoc e a)))
        ((atom (car e)) (cond ((eq (car e) 'quote) (cadr e))
                              ((eq (car e) 'cond) (levcon (cdr e) a))
                              (t (lapply (car e) (levlis (cdr e) a) a))))
        (t (lapply (car e) (levlis (cdr e) a) a))))

(defun levcon (c a)
  (cond ((leval (caar c) a) (leval (cadar c) a))
        (t (levcon (cdr c) a))))

(defun levlis (m a)
  (cond ((null m) nil)
        (t (cons (leval (car m) a)
                 (levlis (cdr m) a)))))