[gambit-list] Patch for SRFI 122 implementation: fixes bug in array-{every, any}

Bradley Lucier lucier at math.purdue.edu
Fri Nov 16 14:45:57 EST 2018


Arthur:

I'm including here a patch for a bug in the implementation of 
array-every and array-any in SRFI 122.

Perhaps you can apply it as is (I don't want to make a new fork of 
srfi-122 just to suggest this fix).

You can see the fix to macro-make-predicates in context here:

https://github.com/gambiteer/srfi-122/blob/master/generic-arrays.scm

Thanks.

Brad
-------------- next part --------------
diff --git a/generic-arrays.scm b/generic-arrays.scm
index f0a9e47..bdd3b84 100644
--- a/generic-arrays.scm
+++ b/generic-arrays.scm
@@ -2479,15 +2479,15 @@
                   ;; (< i upper-i) is always true because index is >= 0
                   (let j-loop ((j lower-j)
                                (index index))
-                    (cond ((zero? index)
+                    (cond ((= j upper-j)
+                           (i-loop (+ i 1)
+                                   index))
+                          ((zero? index)
                            (f i j))
-                          ((< j upper-j)
+                          (else
                            (,connector (f i j)
                                        (j-loop (+ j 1)
-                                               (- index 1))))
-                          (else
-                           (i-loop (+ i 1)
-                                   index)))))))
+                                               (- index 1)))))))))
          ((3) (let ((lower-i (##interval-lower-bound interval 0))
                     (lower-j (##interval-lower-bound interval 1))
                     (lower-k (##interval-lower-bound interval 2))
@@ -2503,15 +2503,15 @@
                     (if (< j upper-j)
                         (let k-loop ((k lower-k)
                                      (index index))
-                          (cond ((zero? index)
+                          (cond ((= k upper-k)
+                                 (j-loop (+ j 1)
+                                         index))
+                                ((zero? index)
                                  (f i j k))
-                                ((< k upper-k)
+                                (else
                                  (,connector (f i j k)
                                              (k-loop (+ k 1)
-                                                     (- index 1))))
-                                (else
-                                 (j-loop (+ j 1)
-                                         index))))
+                                                     (- index 1))))))
                         (i-loop (+ i 1)
                                 index))))))
          ((4) (let ((lower-i (##interval-lower-bound interval 0))
@@ -2533,15 +2533,15 @@
                           (if (< k upper-k)
                               (let l-loop ((l lower-l)
                                            (index index))
-                                (cond ((zero? index)
+                                (cond ((= l upper-l)
+                                       (k-loop (+ k 1)
+                                               index))
+                                      ((zero? index)
                                        (f i j k l))
-                                      ((< l upper-l)
+                                      (else
                                        (,connector (f i j k l)
                                                    (l-loop (+ l 1)
-                                                           (- index 1))))
-                                      (else
-                                       (k-loop (+ k 1)
-                                               index))))
+                                                           (- index 1))))))
                               (j-loop (+ j 1)
                                       index)))
                         (i-loop (+ i 1)


More information about the Gambit-list mailing list