Implement find-map.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 398ad632e1717606cb004b2875ab933ad5d6d3af..ca1205d4df012e1554ac55616f7f845f6a19c435 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3066,6 +3066,7 @@ USA.
          filter!
          filter-map
          find
+         find-map
          find-tail
          length+
          list-index

diff --git a/src/runtime/srfi-1.scm b/src/runtime/srfi-1.scm
index 969fcb61d8b2eb1ee7e69eda08f5fb78f5d9ff61..34521b684ac566d04fa86b4ecf2c5e12faa67d73 100644 (file)
--- a/src/runtime/srfi-1.scm
+++ b/src/runtime/srfi-1.scm
@@ -509,6 +509,19 @@ USA.
              (cond ((f (car lis)) => (lambda (x) (cons x tail)))
                    (else tail)))))))
 
+;; Like filter-map, but returns first non-false value.
+(define (find-map f lis1 . lists)
+  (if (pair? lists)
+      (let iter ((lists (cons lis1 lists)))
+       (receive (cars cdrs) (%cars+cdrs lists)
+         (and (pair? cars)
+              (or (apply f cars)
+                  (iter cdrs)))))
+      (let iter ((lis lis1))
+       (and (not (null-list? lis 'find-map))
+            (or (f (car lis))
+                (iter (cdr lis)))))))
+
 ;;; Map F across lists, guaranteeing to go left-to-right.
 ;;; NOTE: Some implementations of R5RS MAP are compliant with this spec;
 ;;; in which case this procedure may simply be defined as a synonym for MAP.