TAILP

diff --git a/src/list.lisp b/src/list.lisp
index bbb7557..173dedf 100644 (file)
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -116,6 +116,12 @@
          (tree-equal (car tree1) (car tree2) :test test)
          (tree-equal (cdr tree1) (cdr tree2) :test test))))
 
+(defun tailp (object list)
+  (do ((tail list (cdr tail)))
+    ((atom tail) (eq object tail))
+    (when (eql tail object)
+      (return-from tailp t))))
+
 (defun subst (new old tree &key (key #'identity) (test #'eql))
   (cond 
     ((funcall test (funcall key tree) (funcall key old))

diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index 85d926f..0bb2b43 100644 (file)
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -73,8 +73,8 @@
           return-from revappend reverse rplaca rplacd second set setf seventh
           setq sixth some string string-upcase string= stringp subseq subst
           symbol-function symbol-name symbol-package symbol-plist
-          symbol-value symbolp t tagbody tenth third throw tree-equal truncate
-          unless unwind-protect values values-list variable warn when
+          symbol-value symbolp t tagbody tailp tenth third throw tree-equal
+          truncate unless unwind-protect values values-list variable warn when
           write-line write-string zerop))
 
 (setq *package* *user-package*)

diff --git a/tests/list.lisp b/tests/list.lisp
index 02fed92..72da656 100644 (file)
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -31,6 +31,13 @@
   (test (= (ninth   nums) 9))
   (test (= (tenth   nums) 10)))
 
+; TAILP
+(let* ((a (list 1 2 3))
+       (b (cdr a)))
+  (test (tailp b a))
+  (test (tailp a a)))
+(test (tailp 'a (cons 'b 'a)))
+
 ; SUBST
 ; Can't really test this until EQUAL works properly on lists