From 643483ceecc115d48b10f095b31b5eca62e2228b Mon Sep 17 00:00:00 2001 From: Owen Rodley Date: Sat, 4 May 2013 11:26:05 +1200 Subject: [PATCH] TAILP --- src/list.lisp | 6 ++++++ src/toplevel.lisp | 4 ++-- tests/list.lisp | 7 +++++++ 3 files changed, 15 insertions(+), 2 deletions(-) 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 -- 1.7.10.4