(defun null (x) (eq x (quote nil))) (defun not (x) (cond (x (quote nil)) ((quote t) (quote t)))) (defun and (x y) ;; This is not entirely correct, as AND short-circuits, but the original ;; interprter lacks support for AND, so this must do. (cond (x y) ((quote t) (quote nil)))) (defun list (x y) (cons x (cons y (quote nil)))) (defun eval (e a) (cond ((atom e) (assoc e a)) ((atom (car e)) (cond ((eq (car e) (quote quote)) (car (cdr e))) ((eq (car e) (quote atom)) (atom (eval (car (cdr e)) a))) ((eq (car e) (quote eq)) (eq (eval (car (cdr e)) a) (eval (car (cdr (cdr e))) a))) ((eq (car e) (quote cond)) (evcon (cdr e) a)) ((eq (car e) (quote car)) (car (eval (car (cdr e)) a))) ((eq (car e) (quote cdr)) (cdr (eval (car (cdr e)) a))) ((eq (car e) (quote cons)) (cons (eval (car (cdr e)) a) (eval (car (cdr (cdr e))) a))) ((quote t) (eval (cons (assoc (car e) a) (cdr e)) a)))) ((eq (car (car e)) (quote label)) (eval (cons (car (cdr (cdr (car e)))) (cdr e)) (cons (list (car (cdr (car e))) (car e)) a))) ((eq (car (car e)) (quote lambda)) (eval (car (cdr (cdr (car e)))) (append (pair (car (cdr (car e))) (evlis (cdr e) a)) a))))) (defun assoc (x y) (cond ((eq (car (car y)) x) (car (cdr (car y)))) ((quote t) (assoc x (cdr y))))) (defun evcon (c a) (cond ((eval (car (car c)) a) (eval (car (cdr (car c))) a)) ((quote t) (evcon (cdr c) a)))) (defun evlis (m a) (cond ((null m) (quote nil)) ((quote t) (cons (eval (car m) a) (evlis (cdr m) a))))) (defun pair (x y) (cond ((and (null x) (null y)) (quote nil)) ((and (not (atom x)) (not (atom y))) (cons (list (car x) (car y)) (pair (cdr x) (cdr y)))))) (defun append (x y) (cond ((null x) y) ((quote t) (cons (car x) (append (cdr x) y)))))