[PATCH] ‘map’ stops when o ne of the end of lists is reached
[email protected] (Ludovic Courtès)
| Newsgroups | gmane.lisp.scheme.bigloo |
|---|---|
| Message-ID | <[email protected]> |
The attached patch fixes ‘map’ with several lists so that it stops as soon as one of ends of list is reached, not just the first list’s end. Unfortunately I was unable to test it because I fail to bootstrap Bigloo. Thanks, Ludo’.
map.patch
(text/x-patch, 1.3 KB)
diff -r fb869ad7a067 recette/list.scm
--- a/recette/list.scm Mon Mar 03 12:12:08 2014 +0100
+++ b/recette/list.scm Fri Apr 25 11:35:55 2014 +0200
@@ -47,6 +47,8 @@
(test "map.6" (map (lambda (x) x) '()) '())
(test "map.7" (map car '()) '())
(test "map.8" (map car '((1))) '(1))
+ (test "map.9" (map + '(1 2 3 4 5 6) '(1 2 3)) '(2 4 6))
+ (test "map.10" (map + '(1 2 3 4 5 6) '(1 2 3) '(1)) '(3))
(test "append-map" (append-map (lambda (x) (list x (- x))) '(1 3 8))
'(1 -1 3 -3 8 -8))
(test "append-map!" (append-map! (lambda (x) (list x (- x))) '(1 3 8))
diff -r fb869ad7a067 runtime/Ieee/control.scm
--- a/runtime/Ieee/control.scm Mon Mar 03 12:12:08 2014 +0100
+++ b/runtime/Ieee/control.scm Fri Apr 25 11:35:55 2014 +0200
@@ -101,6 +101,13 @@
;* map ... */
;*---------------------------------------------------------------------*/
(define (map f . l)
+ (define (find pred l)
+ (let loop ((l l))
+ (match-case l
+ (() #f)
+ ((head . tail)
+ (or (pred head) (loop tail))))))
+
(cond
((null? l)
'())
@@ -108,7 +115,7 @@
(map-2 f (car l)))
(else
(let loop ((l l))
- (if (null? (car l))
+ (if (find null? l)
'()
(cons (apply f (map-2 car l))
(loop (map-2 cdr l))))))))