From 64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:38 -0800
Subject: Import Upstream version 3a5

---
 collectx.scm | 39 +++++++++++++++++++++++++++------------
 1 file changed, 27 insertions(+), 12 deletions(-)

(limited to 'collectx.scm')

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?
-- 
cgit v1.2.3