RASSOC

diff --git a/src/list.lisp b/src/list.lisp
index 32d0398..a901395 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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