From 39abd0a618f88f8cd5e503ee293ce1a90720836a Mon Sep 17 00:00:00 2001 From: Owen Rodley Date: Sat, 4 May 2013 18:18:26 +1200 Subject: [PATCH] RASSOC --- src/list.lisp | 11 +++++++++-- src/toplevel.lisp | 2 +- tests/list.lisp | 7 +++++++ 3 files changed, 17 insertions(+), 3 deletions(-) diff --git a/src/list.lisp b/src/list.lisp index 32d0398..a901395 100644 --- a/src/list.lisp +++ b/src/list.lisp @@ -180,8 +180,15 @@ (defun assoc (x alist &key (test #'eql)) (while alist (if (funcall test x (caar alist)) - (return) - (setq alist (cdr alist)))) + (return) + (setq alist (cdr alist)))) + (car alist)) + +(defun rassoc (x alist &key (test #'eql)) + (while alist + (if (funcall test x (cdar alist)) + (return) + (setq alist (cdr alist)))) (car alist)) (defun acons (key datum alist) diff --git a/src/toplevel.lisp b/src/toplevel.lisp index f56e92e..99d8602 100644 --- a/src/toplevel.lisp +++ b/src/toplevel.lisp @@ -69,7 +69,7 @@ nconc nil ninth not nreconc nth nthcdr null numberp or otherwise package-name package-use-list packagep pairlis parse-integer plusp pop prin1-to-string print proclaim prog1 prog2 progn psetq push - quote read-from-string remove remove-if remove-if-not return + quote rassoc read-from-string remove remove-if remove-if-not return 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 diff --git a/tests/list.lisp b/tests/list.lisp index be6faff..0b76ba4 100644 --- a/tests/list.lisp +++ b/tests/list.lisp @@ -56,6 +56,13 @@ (test (not (eql (car alist) (car copy)))) (test (equal alist copy))) +; ASSOC and RASSOC +(let ((alist '((1 . 2) (3 . 4)))) + (test (equal (assoc 1 alist) '(1 . 2))) + (test (equal (rassoc 2 alist) '(1 . 2))) + (test (not (assoc 2 alist))) + (test (not (rassoc 1 alist)))) + ; SUBST ; Can't really test this until EQUAL works properly on lists -- 1.7.10.4