mes: Support fold-right 3.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 6 Oct 2018 19:05:43 +0000 (21:05 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 6 Oct 2018 19:05:43 +0000 (21:05 +0200)
* mes/module/srfi/srfi-1.mes (fold-right): Support fold-right 3.
* tests/srfi-1.test ("fold-right-3"): Test it.

mes/module/srfi/srfi-1.mes
tests/srfi-1.test

index 84bf44b6dcc50bec2287056e870b3a2912f99c71..3b3458381ea21c5bfca95028aef4abb1eb1a73f3 100644 (file)
       (let loop ((lst lst1))
         (if (null? lst) init
             (proc (car lst) (loop (cdr lst)))))
-      (error "FOLD-RIGHT-2-NOT-SUPPORTED")))
+      (if (null? (cdr rest))
+          (let loop ((lst1 lst1) (lst2 (car rest)))
+            (if (or (null? lst1)
+                    (null? lst2)) init
+                    (proc (car lst1) (car lst2) (loop (cdr lst1) (cdr lst2)))))
+          (let loop ((lst1 lst1) (lst2 (car rest)) (lst3 (cadr rest)))
+            (if (or (null? lst1)
+                    (null? lst2)
+                    (null? lst3)) init
+                    (proc (car lst1) (car lst2) (car lst3) (loop (cdr lst1) (cdr lst2) (cdr lst3)))))
+          (error "FOLD-RIGHT-4-NOT-SUPPORTED"))))
 
 (define (unfold p f g seed . rest)
   (let ((tail-gen (if (null? rest) (const '())
index b7f0028f18513754aab31bffcde99c31b3fb3cfd..03235473541c4470f2400003600a7b47e4486d8b 100755 (executable)
@@ -65,4 +65,12 @@ exec ${MES-src/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
                '(0 0 1)
                (append-map iota '(1 2)))
 
+(pass-if-equal "fold-3"
+               '(1 A a 2 B b 3 C c)
+               (fold cons* '() '(3 2 1) '(C B A) '(c b a)))
+
+(pass-if-equal "fold-right-3"
+               '(1 A a 2 B b 3 C c)
+               (fold-right cons* '() '(1 2 3) '(A B C) '(a b c)))
+
 (result 'report)