srfi-1: Rewrite 'assoc' in Scheme.

* libguile/srfi-1.c (scm_srfi1_assoc): Remove.
* libguile/srfi-1.h (scm_srfi1_assoc): Likewise.
* module/srfi/srfi-1.scm (assoc): New procedure.

1 files changed, 17 insertions, 0 deletions

diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 1fc7a0e26..680ee94b5 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -923,6 +923,23 @@ and those making the associations."
 
 ;;; Delete / assoc / member
 
+(define* (assoc key alist #:optional (= equal?))
+  "Behaves like @code{assq} but uses third argument @var{pred} for key
+comparison.  If @var{pred} is not supplied, @code{equal?} is
+used.  (Extended from R5RS.)"
+  (cond
+   ((eq? = eq?) (assq key alist))
+   ((eq? = eqv?) (assv key alist))
+   (else
+    (check-arg procedure? = assoc)
+    (let loop ((alist alist))
+      (and (pair? alist)
+           (let ((item (car alist)))
+             (check-arg pair? item assoc)
+             (if (= key (car item))
+                 item
+                 (loop (cdr alist)))))))))
+
 (define* (member x ls #:optional (= equal?))
   (cond
    ;; This might be performance-sensitive, so punt on the check here,