+ (defmacro defun (name args &rest body)
+ `(%defun ,name ,args ,@body))
+
+ (defvar *package* (new))
+
+ (defvar nil (make-symbol "NIL"))
+ (set *package* "NIL" nil)
+
+ (defvar t (make-symbol "T"))
+ (set *package* "T" t)
+
+ (defun internp (name)
+ (in name *package*))
+
+ (defun intern (name)
+ (if (internp name)
+ (get *package* name)
+ (set *package* name (make-symbol name))))
+
+ (defun find-symbol (name)
+ (get *package* name))
+
+ ;; Basic functions
+ (defun = (x y) (= x y))
+ (defun + (x y) (+ x y))
+ (defun - (x y) (- x y))
+ (defun * (x y) (* x y))
+ (defun / (x y) (/ x y))
+ (defun 1+ (x) (+ x 1))
+ (defun 1- (x) (- x 1))
+ (defun zerop (x) (= x 0))
+ (defun truncate (x y) (floor (/ x y)))
+
+ (defun eql (x y) (eq x y))
+
+ (defun not (x) (if x nil t))
+
+ (defun cons (x y ) (cons x y))
+ (defun consp (x) (consp x))
+ (defun car (x) (car x))
+ (defun cdr (x) (cdr x))
+ (defun caar (x) (car (car x)))
+ (defun cadr (x) (car (cdr x)))
+ (defun cdar (x) (cdr (car x)))
+ (defun cddr (x) (cdr (cdr x)))
+ (defun caddr (x) (car (cdr (cdr x))))
+ (defun cdddr (x) (cdr (cdr (cdr x))))
+ (defun cadddr (x) (car (cdr (cdr (cdr x)))))
+ (defun first (x) (car x))
+ (defun second (x) (cadr x))
+ (defun third (x) (caddr x))
+ (defun fourth (x) (cadddr x))
+
+ (defun list (&rest args) args)
+ (defun atom (x)
+ (not (consp x)))
+
+ ;; Basic macros
+
+ (defmacro incf (x &optional (delta 1))
+ `(setq ,x (+ ,x ,delta)))
+
+ (defmacro decf (x &optional (delta 1))
+ `(setq ,x (- ,x ,delta)))
+
+ (defmacro push (x place)
+ `(setq ,place (cons ,x ,place)))
+
+ (defmacro when (condition &rest body)
+ `(if ,condition (progn ,@body) nil))
+
+ (defmacro unless (condition &rest body)
+ `(if ,condition nil (progn ,@body)))
+
+ (defmacro dolist (iter &rest body)
+ (let ((var (first iter))
+ (g!list (make-symbol "LIST")))
+ `(let ((,g!list ,(second iter))
+ (,var nil))
+ (while ,g!list
+ (setq ,var (car ,g!list))
+ ,@body
+ (setq ,g!list (cdr ,g!list))))))
+
+ (defmacro cond (&rest clausules)
+ (if (null clausules)
+ nil
+ (if (eq (caar clausules) t)
+ `(progn ,@(cdar clausules))
+ `(if ,(caar clausules)
+ (progn ,@(cdar clausules))
+ (cond ,@(cdr clausules))))))
+
+ (defmacro case (form &rest clausules)
+ (let ((!form (make-symbol "FORM")))
+ `(let ((,!form ,form))
+ (cond
+ ,@(mapcar (lambda (clausule)
+ (if (eq (car clausule) t)
+ clausule
+ `((eql ,!form ,(car clausule))
+ ,@(cdr clausule))))
+ clausules)))))
+
+ (defmacro ecase (form &rest clausules)
+ `(case ,form
+ ,@(append
+ clausules
+ `((t
+ (error "ECASE expression failed."))))))
+
+ (defmacro and (&rest forms)
+ (cond
+ ((null forms)
+ t)
+ ((null (cdr forms))
+ (car forms))
+ (t
+ `(if ,(car forms)
+ (and ,@(cdr forms))
+ nil))))