LISP in Arc

(def _null (x)
  (is x nil))

(def _and (x y)
  (if (is x t) (is y t) t nil))

(def _not (x)
  (if (is x nil) t))

(def _caar (x)
  (car (car x)))

(def _cadr (x)
  (car (cdr x)))

(def _caddr (x)
  (car (cdr (cdr x))))

(def _cadar (x)
  (car (cdr (car x))))

(def _caddar (x)
  (car (cdr (cdr (car x)))))

(def _append (x y)
  (if (_null x) y (cons (car x) (_append (cdr x) y))))

(def _list (x y)
  (cons x (cons y nil)))

(def _pair (x y)
  (if (_and (_null x) (_null y)) nil
      (_and (_not (atom x)) (_not (atom y)))
      (cons (_list (car x) (car y))
            (_pair (cdr x) (cdr y)))))

(def _assoc (x y)
  (if (is (caar y) x) (_cadar y)
    (_assoc x (cdr y))))

(def _eval (e a)
  (if
    (atom e) (_assoc e a)
    (atom (car e)) (if
      (is (car e) 'quote) (_cadr e)
      (is (car e) 'atom)  (atom (_eval (_cadr  e) a))
      (is (car e) 'eq)    (is   (_eval (_cadr  e) a)
                                (_eval (_caddr e) a))
      (is (car e) 'car)   (car  (_eval (_cadr  e) a))
      (is (car e) 'cdr)   (cdr  (_eval (_cadr  e) a))
      (is (car e) 'cons)  (cons (_eval (_cadr  e) a)
                                (_eval (_caddr e) a))
      (is (car e) 'cond)  (_evcon (cdr e) a)
      (_eval (cons (_assoc (car e) a)
                   (cdr e))
              a))
    (is (caar e) 'label)
      (_eval (cons (_caddar e) (cdr e))
             (cons (_list (_cadar e) (car e)) a))
    (is (caar e) 'lambda)
      (_eval (_caddar e)
             (_append (_pair (_cadar e) (_evlis (cdr e) a))
                      a))))

(def _evcon (c a)
  (if (_eval (_caar c) a)
      (_eval (_cadar c) a)
      (_evcon (cdr c) a)))

(def _evlis (m a)
  (if (_null m) nil
      (cons (_eval  (car m) a)
            (_evlis (cdr m) a))))

(def _appq (m)
  (if (_null m) nil (cons (_list 'quote (car m)) (_appq (cdr m)))))

(def _apply (f args)
  (_eval (cons f (_appq args)) nil))