FIFTH to TENTH

[jscl.git] / src / list.lisp

diff --git a/src/list.lisp b/src/list.lisp
index 64c03c9..bbb7557 100644 (file)
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -29,7 +29,7 @@
       t
       (if (consp x)
           nil
-          (error "type-error"))))
+          (error "The value `~S' is not a type list." x))))
 
 (defun car (x)
   "Return the CAR part of a cons, or NIL if X is null."
@@ -37,11 +37,17 @@
 
 (defun cdr (x) (cdr x))
 
-(defun first (x) (car x))
-(defun second (x) (cadr x))
-(defun third (x) (caddr x))
-(defun fourth (x) (cadddr x))
-(defun rest (x) (cdr x))
+(defun first   (x) (car    x))
+(defun second  (x) (cadr   x))
+(defun third   (x) (caddr  x))
+(defun fourth  (x) (cadddr x))
+(defun fifth   (x) (car    (cddddr x)))
+(defun sixth   (x) (cadr   (cddddr x)))
+(defun seventh (x) (caddr  (cddddr x)))
+(defun eighth  (x) (cadddr (cddddr x)))
+(defun ninth   (x) (car  (cddddr (cddddr x))))
+(defun tenth   (x) (cadr (cddddr (cddddr x))))
+(defun rest    (x) (cdr x))
 
 (defun list (&rest args)
   args)
@@ -62,7 +68,6 @@
 (defun nth (n list)
   (car (nthcdr n list)))
 
-;;; The rest of the C[AD]*R functions; only a few were defined in boot.lisp
 (defun caar (x) (car (car x)))
 (defun cadr (x) (car (cdr x)))
 (defun cdar (x) (cdr (car x)))
@@ -104,6 +109,13 @@
           (copy-tree (cdr tree)))
     tree))
 
+(defun tree-equal (tree1 tree2 &key (test #'eql))
+  (if (atom tree1)
+    (and (atom tree2) (funcall test tree1 tree2))
+    (and (consp tree2)
+         (tree-equal (car tree1) (car tree2) :test test)
+         (tree-equal (cdr tree1) (cdr tree2) :test test))))
+
 (defun subst (new old tree &key (key #'identity) (test #'eql))
   (cond 
     ((funcall test (funcall key tree) (funcall key old))