From f44af3ea16fc48b991dea0b8a40bd42e1de634a0 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 22 Jan 2017 21:46:36 -0800 Subject: [PATCH] Implement find-map. --- src/runtime/runtime.pkg | 1 + src/runtime/srfi-1.scm | 13 +++++++++++++ 2 files changed, 14 insertions(+) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 398ad632e..ca1205d4d 100644 --- 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 969fcb61d..34521b684 100644 --- 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. -- 2.25.1