mes: filter-map: Handle two lists.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 29 Apr 2018 16:29:26 +0000 (18:29 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 29 Apr 2018 16:29:26 +0000 (18:29 +0200)
* module/srfi/srfi-1.mes (filter-map): Handle two lists, add error
  when called with three or more.

module/mes/base.mes
module/srfi/srfi-1.mes

index 704ea5667937bbb060895830c40f418abc033a37..51d0f48854f34129810a4b7552a6984b92514092 100644 (file)
         ((closure? p) #t)
         (#t #f)))
 
-(define (map f l . r)
-  (if (null? l) '()
-      (if (null? r) (cons (f (car l)) (map f (cdr l)))
-          (if (null? (cdr r))
-              (cons (f (car l) (caar r)) (map f (cdr l) (cdar r)))
-              (if (null? (cddr r))
-                  (cons (f (car l) (caar r) (caadr r)) (map f (cdr l) (cdar r) (cdadr r)))
-                  (if (null? (cdddr r))
-                      (cons (f (car l) (caar r) (caadr r) (car (caddr r))) (map f (cdr l) (cdar r) (cdadr r) (cdr (caddr r))))
-                      (error 'unsupported (cons* "map 5:" f l r))) )))))
+(define (map f h . t)
+  (if (null? h) '()
+      (if (null? t) (cons (f (car h)) (map f (cdr h)))
+          (if (null? (cdr t))
+              (cons (f (car h) (caar t)) (map f (cdr h) (cdar t)))
+              (if (null? (cddr t))
+                  (cons (f (car h) (caar t) (caadr t)) (map f (cdr h) (cdar t) (cdadr t)))
+                  (if (null? (cdddr t))
+                      (cons (f (car h) (caar t) (caadr t) (car (caddr t))) (map f (cdr h) (cdar t) (cdadr t) (cdr (caddr t))))
+                      (error 'unsupported (cons* "map 5:" f h t))) )))))
index 321a47f54f0edde3873620c0d7237ffb0868b697..d5103390ca5d37784f33e4b19676d1d3d37da6a4 100644 (file)
 (define (append-map f lst . rest)
   (apply append (apply map f (cons lst rest))))
 
-(define (filter-map f lst)
-  (if (null? lst) (list)
-      (let ((r (f (car lst))))
-        (if r (cons r (filter-map f (cdr lst)))
-            (filter-map f (cdr lst))))))
+(define (filter-map f h . t)
+  (if (null? h) '()
+      (if (null? t)
+          (let ((r (f (car h))))
+            (if r (cons r (filter-map f (cdr h)))
+                (filter-map f (cdr h))))
+          (if (null? (cdr t))
+              (let ((r (f (car h) (caar t))))
+                (if r (cons r (filter-map f (cdr h) (cdar t)))
+                    (filter-map f (cdr h) (cdar t))))
+              (error 'unsupported (cons* "filter-map 3:" f h t))))))
 
 ;;; nyacc requirements