Import Upstream version 3a5upstream/3a5

1 files changed, 27 insertions, 12 deletions

diff --git a/collectx.scm b/collectx.scm
index 7ba46b9..5ca0ca5 100644
--- a/collectx.scm
+++ b/collectx.scm
@@ -132,18 +132,33 @@
 ;@
 (define reduce
   (lambda (<proc>!1 <seed>!1 . <collections>!1)
-    (let ((max+1!2 (collect:size (car <collections>!1)))
-          (generators!2
-            (map collect:gen-elts <collections>!1)))
-      (let loop!4 ((count!3 0))
-        (cond ((< count!3 max+1!2)
-               (set! <seed>!1
-                 (apply <proc>!1
-                        <seed>!1
-                        (map (lambda (g!5) (g!5)) generators!2)))
-               (loop!4 (collect:add1 count!3)))
-              (else <seed>!1))))))
-
+    (letrec ((reduce-init!3
+               (lambda (pred?!8 init!8 lst!8)
+                 (if (null? lst!8)
+                   init!8
+                   (reduce-init!3
+                     pred?!8
+                     (pred?!8 init!8 (car lst!8))
+                     (cdr lst!8))))))
+      (if (null? <collections>!1)
+        (cond ((null? <seed>!1) <seed>!1)
+              ((null? (cdr <seed>!1)) (car <seed>!1))
+              (else
+               (reduce-init!3
+                 <proc>!1
+                 (car <seed>!1)
+                 (cdr <seed>!1))))
+        (let ((max+1!4 (collect:size (car <collections>!1)))
+              (generators!4
+                (map collect:gen-elts <collections>!1)))
+          (let loop!6 ((count!5 0))
+            (cond ((< count!5 max+1!4)
+                   (set! <seed>!1
+                     (apply <proc>!1
+                            <seed>!1
+                            (map (lambda (g!7) (g!7)) generators!4)))
+                   (loop!6 (collect:add1 count!5)))
+                  (else <seed>!1))))))))
 
 
 ;;@ pred true for every elt?