; rip john mccarthy

(define (atom? x) (not (pair? x)))

(define (*pairlis x y a)
  (cond ((null? x) a)
        (else (cons (cons (car x) (car y))
                    (*pairlis (cdr x) (cdr y) a)))))

(define (*assoc x a)
  (cond ((equal? (caar a) x) (car a))
        (else (*assoc x (cdr a)))))

(define (*apply 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)))
                (else (*apply (*eval fn a) x a))))
        ((eq? (car fn) 'lambda)
          (*eval (caddr fn) (*pairlis (cadr fn) x a)))
        ((eq? (car fn) 'label)
          (*apply (caddr fn) x (cons (cons (cadr fn) (caddr fn)) a)))))

(define (*eval e a)
  (cond ((atom? e) (cdr (*assoc e a)))
        ((atom? (car e))
          (cond ((eq? (car e) 'quote) (cadr e))
                ((eq? (car e) 'cond) (*evcon (cdr e) a))
                (else (*apply (car e) (*evlis (cdr e) a) a))))
        (else (*apply (car e) (*evlis (cdr e) a) a))))

(define (*evcon c a)
  (cond ((*eval (caar c) a) (*eval (cadar c) a))
        (else (*evcon (cdr c) a))))

(define (*evlis m a)
  (cond ((null? m) '())
        (else (cons (*eval (car m) a) (*evlis (cdr m) a)))))

(define (*evalquote fn x) (*apply fn x '()))

(display (*evalquote '(lambda (x y) (cons (car x) y)) '((a b) (c d))))
(newline)

(display
  (*evalquote
    '(label reverse
      (lambda (ls new)
        (cond ((null ls) new)
              ((quote t) (reverse (cdr ls) (cons (car ls) new))))))
    '(reverse (a b c d e) ())))
(newline)

(a c d)
caar: expects argument of type <caarable value>; given ()

 === context ===
Line 10:0: *assoc
Line 27:0: *eval
Line 14:0: *apply
Line 35:0: *evcon