From: Owen Rodley <Strigoides@gmail.com>
Date: Fri, 3 May 2013 23:26:05 +0000 (+1200)
Subject: TAILP
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=643483ceecc115d48b10f095b31b5eca62e2228b;p=jscl.git

TAILP
---

diff --git a/src/list.lisp b/src/list.lisp
index bbb7557..173dedf 100644
--- 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
--- 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
--- 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