bug#17485: (srfi srfi-1) reduce-right does not scale, version 2.0.9

bug#17485: (srfi srfi-1) reduce-right does not scale, version 2.0.9

[David Kastrup]

The following code results in an error:

(use-modules (srfi srfi-1))
(reduce-right + 0 (make-list 10000 1))

Backtrace:
In srfi/srfi-1.scm:
 379: 19 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 18 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 17 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 16 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 15 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 14 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 13 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 12 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 11 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 10 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 9 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 8 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 7 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 6 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 5 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 4 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 3 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 2 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 1 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
 379: 0 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]

srfi/srfi-1.scm:379:31: In procedure recur:
srfi/srfi-1.scm:379:31: Throw to key `vm-error' with args `(vm-run "VM: Stack overflow" ())'.

This is for Guile version 2.0.9 as distributed by Ubuntu 14.04.

Somewhat surprisingly, fold-right does not suffer from the same error.

Surprisingly because the definition of reduce-right is

(define (reduce-right f ridentity lst)
  "`reduce-right' is a variant of `fold-right', where the first call to
F is on two elements from LST, rather than one element and a given
initial value.  If LST is empty, RIDENTITY is returned.  If LST
has just one element then that's the return value."
  (check-arg procedure? f reduce)
  (if (null? lst)
      ridentity
      (fold-right f (last lst) (drop-right lst 1))))

It turns out that the call of drop-right is responsible here:

(define (drop-right lis k)
  (let recur ((lag lis) (lead (drop lis k)))
    (if (pair? lead)
        (cons (car lag) (recur (cdr lag) (cdr lead)))
        '())))

For all the cleverness involved here, one has to run through the whole
list anyway.  It makes no real sense to do this in this manner.  The
motivation may be to have a warm cache when k is small, but the result
is self-defeating because of VM stack buildup.

(define (drop-right lis k)
    (drop lis (- (length lis) k)))

should be all that is needed.

-- 
David Kastrup

bug#17485: (srfi srfi-1) reduce-right does not scale, version 2.0.9

[Mark H Weaver]

David Kastrup <dak@gnu.org> writes:

> The following code results in an error:
>
> (use-modules (srfi srfi-1))
> (reduce-right + 0 (make-list 10000 1))

[...]

> srfi/srfi-1.scm:379:31: In procedure recur:
> srfi/srfi-1.scm:379:31: Throw to key `vm-error' with args `(vm-run "VM: Stack overflow" ())'.

Yes, this should be fixed.

> It turns out that the call of drop-right is responsible here:
>
> (define (drop-right lis k)
>   (let recur ((lag lis) (lead (drop lis k)))
>     (if (pair? lead)
>         (cons (car lag) (recur (cdr lag) (cdr lead)))
>         '())))

Thanks for tracking this down.

> For all the cleverness involved here, one has to run through the whole
> list anyway.  It makes no real sense to do this in this manner.  The
> motivation may be to have a warm cache when k is small, but the result
> is self-defeating because of VM stack buildup.
>
> (define (drop-right lis k)
>     (drop lis (- (length lis) k)))
>
> should be all that is needed.

That won't be sufficient.  SRFI-1 specifies that 'drop-right' works for
dotted lists, i.e. finite non-nil-terminated lists, whereas 'length'
accepts only proper lists.

It includes these examples:

  (drop-right '(1 2 3 . d) 2) => (1)
  (drop-right '(1 2 3 . d) 0) => (1 2 3)

See <http://srfi.schemers.org/srfi-1/srfi-1.html>.

Would you like to propose another fix?

    Thanks,
      Mark

bug#17485: (srfi srfi-1) reduce-right does not scale, version 2.0.9

[David Kastrup]

Mark H Weaver <mhw@netris.org> writes:

> David Kastrup <dak@gnu.org> writes:
>
>> For all the cleverness involved here, one has to run through the whole
>> list anyway.  It makes no real sense to do this in this manner.  The
>> motivation may be to have a warm cache when k is small, but the result
>> is self-defeating because of VM stack buildup.
>>
>> (define (drop-right lis k)
>>     (drop lis (- (length lis) k)))
>>
>> should be all that is needed.
>
> That won't be sufficient.  SRFI-1 specifies that 'drop-right' works
> for dotted lists, i.e. finite non-nil-terminated lists, whereas
> 'length' accepts only proper lists.

Yes, I noticed.

> It includes these examples:
>
>   (drop-right '(1 2 3 . d) 2) => (1)
>   (drop-right '(1 2 3 . d) 0) => (1 2 3)
>
> See <http://srfi.schemers.org/srfi-1/srfi-1.html>.
>
> Would you like to propose another fix?

The simplest fix would be using length+ rather than length, but that
would require length+ to return the length of dotted lists (defined as
its spine) rather than #f.  As I interpret the standard, length+ for
dotted lists is unspecified.  It now returns #f.  Other options would be
throwing an error, delivering the length of the spine, or returning the
negative of the total number of elements (meaning that the "dotted list"
5 has a length+ of -1, distinguishable from (length+ '())).

Since it is suggested in srfi-1 that many routines do something useful
when given dotted lists, it's rather inconvenient that there is _no_
list length operator working on dotted lists.  There are routines that
use length+ as a building block in order to admit circular lists and
they tend to fail with surprising error messages when given dotted
lists.

So I lean towards making length+ put out the spine length of dotted
lists, obviously requiring a review of its few uses.  Having yet another
length operator, in contrast, seems like overkill.  While a "arithmetic
if" style operator yanking out negative values for dotted lists would
have the advantage of delivering complete information, its usage would,
well, be awkward.  And in explicit recursion/loops, one will eventually
arrive at the end of the processed list and will see whether the first
non-pair is '() or not without additional cost.

-- 
David Kastrup

bug#17485: [PATCH 1/3] Let length+ return the length of dotted lists rather than #f

[David Kastrup]

* libguile/srfi-1.c (scm_srfi1_length_plus): Previously, length+
  returned #f for dotted lists.  This leaves the user with no efficient
  means for determining the length of dotted lists.  While the Scheme
  standard does not prescribe a behavior here, the reference
  implementation at
  <URL:http://srfi.schemers.org/srfi-1/srfi-1-reference.scm> indeed
  returns the spine length (number of successive pairs in the cdr-chain)
  of dotted lists rather than #f, providing a good endorsement of this
  behavior.

  As one consequence, the multi-list implementations for map, fold, and
  for-each will happen to accept dotted lists as the shortest list.
  Previously, this caused an error late during processing.

Signed-off-by: David Kastrup <dak@gnu.org>
---
 libguile/srfi-1.c            | 28 ++++++++++++++++++++++++++--
 module/srfi/srfi-1.scm       | 10 +++++-----
 test-suite/tests/srfi-1.test | 28 +++++++++++++++-------------
 3 files changed, 46 insertions(+), 20 deletions(-)

diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index aaa3efe..0db6388 100644
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -614,8 +614,32 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
 	    "circular.")
 #define FUNC_NAME s_scm_srfi1_length_plus
 {
-  long len = scm_ilength (lst);
-  return (len >= 0 ? SCM_I_MAKINUM (len) : SCM_BOOL_F);
+  /* This uses the "tortoise and hare" algorithm to detect "infinitely
+     long" lists (i.e. lists with cycles in their cdrs), and returns #f
+     if it does find one.
+
+     Dotted lists are treated just like regular lists, returning the
+     length of the spine.  This is in conformance with the reference
+     implementation though not explicitly defined in the standard. */
+  long i = 0;
+  SCM tortoise = lst;
+  SCM hare = lst;
+
+  do {
+    if (!scm_is_pair (hare)) return scm_from_long (i);
+    hare = SCM_CDR(hare);
+    i++;
+    if (!scm_is_pair (hare)) return scm_from_long (i);
+    hare = SCM_CDR(hare);
+    i++;
+    /* For every two steps the hare takes, the tortoise takes one.  */
+    tortoise = SCM_CDR(tortoise);
+  }
+  while (!scm_is_eq (hare, tortoise));
+
+  /* If the tortoise ever catches the hare, then the list must contain
+     a cycle.  */
+  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 0806e73..bc72048 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -474,7 +474,7 @@ that result.  See the manual for details."
                      (or len1 len2))))
        (unless len
          (scm-error 'wrong-type-arg "fold"
-                    "Args do not contain a proper (finite) list: ~S"
+                    "Args do not contain a finite list: ~S"
                     (list (list list1 list2)) #f))
        (let fold2 ((knil knil) (list1 list1) (list2 list2) (len len))
          (if (zero? len)
@@ -601,7 +601,7 @@ has just one element then that's the return value."
                      (or len1 len2))))
        (unless len
          (scm-error 'wrong-type-arg "map"
-                    "Args do not contain a proper (finite) list: ~S"
+                    "Args do not contain a finite list: ~S"
                     (list (list l1 l2)) #f))
        (let map2 ((l1 l1) (l2 l2) (len len))
          (if (zero? len)
@@ -620,7 +620,7 @@ has just one element then that's the return value."
                       rest)))
        (if (not len)
            (scm-error 'wrong-type-arg "map"
-                      "Args do not contain a proper (finite) list: ~S"
+                      "Args do not contain a finite list: ~S"
                       (list (cons l1 rest)) #f))
        (let mapn ((l1 l1) (rest rest) (len len))
          (if (zero? len)
@@ -649,7 +649,7 @@ has just one element then that's the return value."
                      (or len1 len2))))
        (unless len
          (scm-error 'wrong-type-arg "for-each"
-                    "Args do not contain a proper (finite) list: ~S"
+                    "Args do not contain a finite list: ~S"
                     (list (list l1 l2)) #f))
        (let for-each2 ((l1 l1) (l2 l2) (len len))
          (unless (zero? len)
@@ -667,7 +667,7 @@ has just one element then that's the return value."
                       rest)))
        (if (not len)
            (scm-error 'wrong-type-arg "for-each"
-                      "Args do not contain a proper (finite) list: ~S"
+                      "Args do not contain a finite list: ~S"
                       (list (cons l1 rest)) #f))
        (let for-eachn ((l1 l1) (rest rest) (len len))
          (if (> len 0)
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index d40f8e1..9364ea2 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -1187,19 +1187,21 @@
     (pass-if-exception "proc arg count 4" exception:wrong-num-args
       (fold (lambda (x y z prev) x) 1 '(1 2 3) '(1 2 3)))
 
-    (pass-if-exception "improper first 1" exception:wrong-type-arg
-      (fold + 1 1 '(1 2 3)))
-    (pass-if-exception "improper first 2" exception:wrong-type-arg
-      (fold + 1 '(1 . 2) '(1 2 3)))
-    (pass-if-exception "improper first 3" exception:wrong-type-arg
-      (fold + 1 '(1 2 . 3) '(1 2 3)))
-
-    (pass-if-exception "improper second 1" exception:wrong-type-arg
-      (fold + 1 '(1 2 3) 1))
-    (pass-if-exception "improper second 2" exception:wrong-type-arg
-      (fold + 1 '(1 2 3) '(1 . 2)))
-    (pass-if-exception "improper second 3" exception:wrong-type-arg
-      (fold + 1 '(1 2 3) '(1 2 . 3)))
+    ;; For multiple list arguments, dotted lists are permitted by this
+    ;; implementation and a non-list is a zero-length dotted list
+    (pass-if "improper first 1"
+      (= 1 (fold + 1 1 '(1 2 3))))
+    (pass-if "improper first 2"
+      (= 3 (fold + 1 '(1 . 2) '(1 2 3))))
+    (pass-if "improper first 3"
+      (= 7 (fold + 1 '(1 2 . 3) '(1 2 3))))
+
+    (pass-if "improper second 1"
+      (= 1 (fold + 1 '(1 2 3) 1)))
+    (pass-if "improper second 2"
+      (= 3 (fold + 1 '(1 2 3) '(1 . 2))))
+    (pass-if "improper second 3"
+      (= 7 (fold + 1 '(1 2 3) '(1 2 . 3))))
 
     (pass-if (= 6 (fold + 1 '(2) '(3))))
     (pass-if (= 15 (fold + 1 '(2 3) '(4 5))))
-- 
1.9.1

bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right!

[David Kastrup]

* module/srfi/srfi-1.scm (take-right, drop-right, drop-right!): The
  definitions tended to be overly complicate and/or rely on pushing
  material on the VM stack, detrimental to scalability for Guile 2.0 and
  also worse for performance.

  The changed definitions lead to different, more accurate exceptions
  being raised.  They rely on length+ returning the length of dotted
  lists, behavior that is not specified by the SRFI-1 definition but
  available in GUILE.

Signed-off-by: David Kastrup <dak@gnu.org>
---
 module/srfi/srfi-1.scm       | 44 ++++++++++++++++++++------------------------
 test-suite/tests/srfi-1.test | 24 ++++++++++++------------
 2 files changed, 32 insertions(+), 36 deletions(-)

diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index bc72048..73d164a 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -363,21 +363,24 @@ end-of-list checking in contexts where dotted lists are allowed."
 (define take list-head)
 (define drop list-tail)
 
-;;; TAKE-RIGHT and DROP-RIGHT work by getting two pointers into the list, 
-;;; off by K, then chasing down the list until the lead pointer falls off
-;;; the end.  Note that they diverge for circular lists.
+;;; TAKE-RIGHT and DROP-RIGHT make use of this implementation's length+
+;;; being defined for dotted lists.  They error out for circular lists.
 
 (define (take-right lis k)
-  (let lp ((lag lis)  (lead (drop lis k)))
-    (if (pair? lead)
-	(lp (cdr lag) (cdr lead))
-	lag)))
+  (let ((len (length+ lis)))
+    (if len
+        (if (<= 0 k len)
+            (drop lis (- len k))
+            (out-of-range 'take-right k))
+        (wrong-type-arg 'take-right lis))))
 
 (define (drop-right lis k)
-  (let recur ((lag lis) (lead (drop lis k)))
-    (if (pair? lead)
-	(cons (car lag) (recur (cdr lag) (cdr lead)))
-	'())))
+  (let ((len (length+ lis)))
+    (if len
+        (if (<= 0 k len)
+            (take lis (- len k))
+            (out-of-range 'drop-right k))
+        (wrong-type-arg 'drop-right lis))))
 
 (define (take! lst i)
   "Linear-update variant of `take'."
@@ -389,19 +392,12 @@ end-of-list checking in contexts where dotted lists are allowed."
 
 (define (drop-right! lst i)
   "Linear-update variant of `drop-right'."
-  (let ((tail (drop lst i)))
-    (if (null? tail)
-        '()
-        (let loop ((prev lst)
-                   (tail (cdr tail)))
-          (if (null? tail)
-              (if (pair? prev)
-                  (begin
-                    (set-cdr! prev '())
-                    lst)
-                  lst)
-              (loop (cdr prev)
-                    (cdr tail)))))))
+  (let ((len (length+ lst)))
+    (if len
+        (if (<= 0 i len)
+            (take! lst (- len i))
+            (out-of-range 'drop-right! i))
+        (wrong-type-arg 'drop-right! lst))))
 
 (define (split-at lst i)
   "Return two values, a list of the elements before index I in LST, and
diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test
index 9364ea2..032bfa4 100644
--- a/test-suite/tests/srfi-1.test
+++ b/test-suite/tests/srfi-1.test
@@ -877,14 +877,14 @@
   (pass-if-exception "() -1" exception:out-of-range
     (drop-right '() -1))
   (pass-if (equal? '() (drop-right '() 0)))
-  (pass-if-exception "() 1" exception:wrong-type-arg
+  (pass-if-exception "() 1" exception:out-of-range
     (drop-right '() 1))
 
   (pass-if-exception "(1) -1" exception:out-of-range
     (drop-right '(1) -1))
   (pass-if (equal? '(1) (drop-right '(1) 0)))
   (pass-if (equal? '() (drop-right '(1) 1)))
-  (pass-if-exception "(1) 2" exception:wrong-type-arg
+  (pass-if-exception "(1) 2" exception:out-of-range
     (drop-right '(1) 2))
 
   (pass-if-exception "(4 5) -1" exception:out-of-range
@@ -892,7 +892,7 @@
   (pass-if (equal? '(4 5) (drop-right '(4 5) 0)))
   (pass-if (equal? '(4) (drop-right '(4 5) 1)))
   (pass-if (equal? '() (drop-right '(4 5) 2)))
-  (pass-if-exception "(4 5) 3" exception:wrong-type-arg
+  (pass-if-exception "(4 5) 3" exception:out-of-range
     (drop-right '(4 5) 3))
 
   (pass-if-exception "(4 5 6) -1" exception:out-of-range
@@ -901,7 +901,7 @@
   (pass-if (equal? '(4 5) (drop-right '(4 5 6) 1)))
   (pass-if (equal? '(4) (drop-right '(4 5 6) 2)))
   (pass-if (equal? '() (drop-right '(4 5 6) 3)))
-  (pass-if-exception "(4 5 6) 4" exception:wrong-type-arg
+  (pass-if-exception "(4 5 6) 4" exception:out-of-range
     (drop-right '(4 5 6) 4))
 
   (pass-if "(a b . c) 0"
@@ -918,14 +918,14 @@
   (pass-if-exception "() -1" exception:out-of-range
     (drop-right! '() -1))
   (pass-if (equal? '() (drop-right! '() 0)))
-  (pass-if-exception "() 1" exception:wrong-type-arg
+  (pass-if-exception "() 1" exception:out-of-range
     (drop-right! '() 1))
 
   (pass-if-exception "(1) -1" exception:out-of-range
     (drop-right! (list 1) -1))
   (pass-if (equal? '(1) (drop-right! (list 1) 0)))
   (pass-if (equal? '() (drop-right! (list 1) 1)))
-  (pass-if-exception "(1) 2" exception:wrong-type-arg
+  (pass-if-exception "(1) 2" exception:out-of-range
     (drop-right! (list 1) 2))
 
   (pass-if-exception "(4 5) -1" exception:out-of-range
@@ -933,7 +933,7 @@
   (pass-if (equal? '(4 5) (drop-right! (list 4 5) 0)))
   (pass-if (equal? '(4) (drop-right! (list 4 5) 1)))
   (pass-if (equal? '() (drop-right! (list 4 5) 2)))
-  (pass-if-exception "(4 5) 3" exception:wrong-type-arg
+  (pass-if-exception "(4 5) 3" exception:out-of-range
     (drop-right! (list 4 5) 3))
 
   (pass-if-exception "(4 5 6) -1" exception:out-of-range
@@ -942,7 +942,7 @@
   (pass-if (equal? '(4 5) (drop-right! (list 4 5 6) 1)))
   (pass-if (equal? '(4) (drop-right! (list 4 5 6) 2)))
   (pass-if (equal? '() (drop-right! (list 4 5 6) 3)))
-  (pass-if-exception "(4 5 6) 4" exception:wrong-type-arg
+  (pass-if-exception "(4 5 6) 4" exception:out-of-range
     (drop-right! (list 4 5 6) 4)))
 
 ;;
@@ -2603,14 +2603,14 @@
   (pass-if-exception "() -1" exception:out-of-range
     (take-right '() -1))
   (pass-if (equal? '() (take-right '() 0)))
-  (pass-if-exception "() 1" exception:wrong-type-arg
+  (pass-if-exception "() 1" exception:out-of-range
     (take-right '() 1))
 
   (pass-if-exception "(1) -1" exception:out-of-range
     (take-right '(1) -1))
   (pass-if (equal? '() (take-right '(1) 0)))
   (pass-if (equal? '(1) (take-right '(1) 1)))
-  (pass-if-exception "(1) 2" exception:wrong-type-arg
+  (pass-if-exception "(1) 2" exception:out-of-range
     (take-right '(1) 2))
 
   (pass-if-exception "(4 5) -1" exception:out-of-range
@@ -2618,7 +2618,7 @@
   (pass-if (equal? '() (take-right '(4 5) 0)))
   (pass-if (equal? '(5) (take-right '(4 5) 1)))
   (pass-if (equal? '(4 5) (take-right '(4 5) 2)))
-  (pass-if-exception "(4 5) 3" exception:wrong-type-arg
+  (pass-if-exception "(4 5) 3" exception:out-of-range
     (take-right '(4 5) 3))
 
   (pass-if-exception "(4 5 6) -1" exception:out-of-range
@@ -2627,7 +2627,7 @@
   (pass-if (equal? '(6) (take-right '(4 5 6) 1)))
   (pass-if (equal? '(5 6) (take-right '(4 5 6) 2)))
   (pass-if (equal? '(4 5 6) (take-right '(4 5 6) 3)))
-  (pass-if-exception "(4 5 6) 4" exception:wrong-type-arg
+  (pass-if-exception "(4 5 6) 4" exception:out-of-range
     (take-right '(4 5 6) 4))
 
   (pass-if "(a b . c) 0"
-- 
1.9.1

bug#17485: [PATCH 3/3] Reimplement reduce-right in srfi-1

[David Kastrup]

* module/srfi/srfi-1.scm (reduce-right): Avoid use of drop-right in
  connection with last as a single upfront reverse is more efficient and
  simpler to understand.

Signed-off-by: David Kastrup <dak@gnu.org>
---
 module/srfi/srfi-1.scm | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 73d164a..6aa249a 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -573,10 +573,7 @@ then that's the return value."
 F is on two elements from LST, rather than one element and a given
 initial value.  If LST is empty, RIDENTITY is returned.  If LST
 has just one element then that's the return value."
-  (check-arg procedure? f reduce)
-  (if (null? lst)
-      ridentity
-      (fold-right f (last lst) (drop-right lst 1))))
+  (reduce f ridentity (reverse lst)))
 
 (define map
   (case-lambda
-- 
1.9.1

bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right!

[Mark H Weaver]

I like this patch, but I think your extended 'length+' procedure should
be given a different name.

     Mark

bug#17485: [PATCH 3/3] Reimplement reduce-right in srfi-1

[Mark H Weaver]

David Kastrup <dak@gnu.org> writes:

> * module/srfi/srfi-1.scm (reduce-right): Avoid use of drop-right in
>   connection with last as a single upfront reverse is more efficient and
>   simpler to understand.
>
> Signed-off-by: David Kastrup <dak@gnu.org>
> ---
>  module/srfi/srfi-1.scm | 5 +----
>  1 file changed, 1 insertion(+), 4 deletions(-)
>
> diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
> index 73d164a..6aa249a 100644
> --- a/module/srfi/srfi-1.scm
> +++ b/module/srfi/srfi-1.scm
> @@ -573,10 +573,7 @@ then that's the return value."
>  F is on two elements from LST, rather than one element and a given
>  initial value.  If LST is empty, RIDENTITY is returned.  If LST
>  has just one element then that's the return value."
> -  (check-arg procedure? f reduce)
> -  (if (null? lst)
> -      ridentity
> -      (fold-right f (last lst) (drop-right lst 1))))
> +  (reduce f ridentity (reverse lst)))
>  
>  (define map
>    (case-lambda

Looks good to me.

     Mark

bug#17485: [PATCH 1/3] Let length+ return the length of dotted lists rather than #f

[Mark H Weaver]

Hi David,

David Kastrup <dak@gnu.org> writes:

> * libguile/srfi-1.c (scm_srfi1_length_plus): Previously, length+
>   returned #f for dotted lists.  This leaves the user with no efficient
>   means for determining the length of dotted lists.  While the Scheme
>   standard does not prescribe a behavior here, the reference
>   implementation at
>   <URL:http://srfi.schemers.org/srfi-1/srfi-1-reference.scm> indeed
>   returns the spine length (number of successive pairs in the cdr-chain)
>   of dotted lists rather than #f, providing a good endorsement of this
>   behavior.
>
>   As one consequence, the multi-list implementations for map, fold, and
>   for-each will happen to accept dotted lists as the shortest list.
>   Previously, this caused an error late during processing.

In general, rationales don't belong in the commit logs.  As per the GNU
coding standards, change logs should only summarize the changes made.

>
> Signed-off-by: David Kastrup <dak@gnu.org>
> ---
>  libguile/srfi-1.c            | 28 ++++++++++++++++++++++++++--
>  module/srfi/srfi-1.scm       | 10 +++++-----
>  test-suite/tests/srfi-1.test | 28 +++++++++++++++-------------
>  3 files changed, 46 insertions(+), 20 deletions(-)
>
> diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
> index aaa3efe..0db6388 100644
> --- a/libguile/srfi-1.c
> +++ b/libguile/srfi-1.c
> @@ -614,8 +614,32 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
>  	    "circular.")
>  #define FUNC_NAME s_scm_srfi1_length_plus
>  {
> -  long len = scm_ilength (lst);
> -  return (len >= 0 ? SCM_I_MAKINUM (len) : SCM_BOOL_F);
> +  /* This uses the "tortoise and hare" algorithm to detect "infinitely
> +     long" lists (i.e. lists with cycles in their cdrs), and returns #f
> +     if it does find one.
> +
> +     Dotted lists are treated just like regular lists, returning the
> +     length of the spine.  This is in conformance with the reference
> +     implementation though not explicitly defined in the standard. */
> +  long i = 0;

Please use 'size_t' instead of 'long'.

> +  SCM tortoise = lst;
> +  SCM hare = lst;
> +
> +  do {
> +    if (!scm_is_pair (hare)) return scm_from_long (i);

scm_from_size_t

> +    hare = SCM_CDR(hare);
> +    i++;
> +    if (!scm_is_pair (hare)) return scm_from_long (i);

Ditto.

> +    hare = SCM_CDR(hare);
> +    i++;
> +    /* For every two steps the hare takes, the tortoise takes one.  */
> +    tortoise = SCM_CDR(tortoise);
> +  }
> +  while (!scm_is_eq (hare, tortoise));

Please follow the GNU conventions for indentation.

> +
> +  /* If the tortoise ever catches the hare, then the list must contain
> +     a cycle.  */
> +  return SCM_BOOL_F;
>  }
>  #undef FUNC_NAME

Otherwise, this function looks good to me, but I'd prefer to give it a
new name and move it into list.c, rather than extending SRFI-1's
'length+'.

Hmm, coming up with names is hard.  Maybe 'length*'?

    Thanks,
      Mark

bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right!

[Mark H Weaver]

David Kastrup <dak@gnu.org> writes:

> * module/srfi/srfi-1.scm (take-right, drop-right, drop-right!): The
>   definitions tended to be overly complicate and/or rely on pushing
>   material on the VM stack, detrimental to scalability for Guile 2.0 and
>   also worse for performance.
>
>   The changed definitions lead to different, more accurate exceptions
>   being raised.  They rely on length+ returning the length of dotted
>   lists, behavior that is not specified by the SRFI-1 definition but
>   available in GUILE.

I forgot to mention that, again, the commit log should not contain
rationales, but merely summarize the changes made.

     Thanks,
       Mark

bug#17485: [PATCH 1/3] Let length+ return the length of dotted lists rather than #f

[David Kastrup]

Mark H Weaver <mhw@netris.org> writes:

> Hi David,
>
> David Kastrup <dak@gnu.org> writes:
>
>> * libguile/srfi-1.c (scm_srfi1_length_plus): Previously, length+
>>   returned #f for dotted lists.  This leaves the user with no efficient
>>   means for determining the length of dotted lists.  While the Scheme
>>   standard does not prescribe a behavior here, the reference
>>   implementation at
>>   <URL:http://srfi.schemers.org/srfi-1/srfi-1-reference.scm> indeed
>>   returns the spine length (number of successive pairs in the cdr-chain)
>>   of dotted lists rather than #f, providing a good endorsement of this
>>   behavior.
>>
>>   As one consequence, the multi-list implementations for map, fold, and
>>   for-each will happen to accept dotted lists as the shortest list.
>>   Previously, this caused an error late during processing.
>
> In general, rationales don't belong in the commit logs.  As per the GNU
> coding standards, change logs should only summarize the changes made.
>
>>
>> Signed-off-by: David Kastrup <dak@gnu.org>
>> ---
>>  libguile/srfi-1.c            | 28 ++++++++++++++++++++++++++--
>>  module/srfi/srfi-1.scm       | 10 +++++-----
>>  test-suite/tests/srfi-1.test | 28 +++++++++++++++-------------
>>  3 files changed, 46 insertions(+), 20 deletions(-)
>>
>> diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
>> index aaa3efe..0db6388 100644
>> --- a/libguile/srfi-1.c
>> +++ b/libguile/srfi-1.c
>> @@ -614,8 +614,32 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
>>  	    "circular.")
>>  #define FUNC_NAME s_scm_srfi1_length_plus
>>  {
>> -  long len = scm_ilength (lst);
>> -  return (len >= 0 ? SCM_I_MAKINUM (len) : SCM_BOOL_F);
>> +  /* This uses the "tortoise and hare" algorithm to detect "infinitely
>> +     long" lists (i.e. lists with cycles in their cdrs), and returns #f
>> +     if it does find one.
>> +
>> +     Dotted lists are treated just like regular lists, returning the
>> +     length of the spine.  This is in conformance with the reference
>> +     implementation though not explicitly defined in the standard. */
>> +  long i = 0;
>
> Please use 'size_t' instead of 'long'.

libguile/list.h:SCM_API long scm_ilength (SCM sx);

libguile/list.c:
SCM_DEFINE (scm_length, "length", 1, 0, 0, 
           (SCM lst),
            "Return the number of elements in list @var{lst}.")
#define FUNC_NAME s_scm_length
{
  long i;
  SCM_VALIDATE_LIST_COPYLEN (1, lst, i);
  return scm_from_long (i);
}

libguile/validate.h:
#define SCM_VALIDATE_LIST_COPYLEN(pos, lst, cvar) \
  do { \
    cvar = scm_ilength (lst); \
    SCM_ASSERT (cvar >= 0, lst, pos, FUNC_NAME); \
  } while (0)

_All_ of the existing list length operations including primitives like
"length", "list?" and other stuff are based on "long".

I understand your rationale, but it does not appear to make sense to
follow it only in one place.

The code actually was mostly a copy&paste job from scm_ilength which is
at the core of "length".

> Otherwise, this function looks good to me, but I'd prefer to give it a
> new name and move it into list.c, rather than extending SRFI-1's
> 'length+'.
>
> Hmm, coming up with names is hard.  Maybe 'length*'?

Given what cons* (and use of id* in syntax rules) does, the name seems
inappropriate.  length* would be a good name for

(length* clist1 clist* ... )

returns the length of the shortest finite list in the given lists, #f if
there is none.  Which would be actually a rather nice building block to
have for several srfi-1 functions and would basically not make us need
length+ at all in its implementation.

Of course, making it very likely that people "will depend on length*™".

-- 
David Kastrup

bug#17485: [PATCH 1/3] Let length+ return the length of dotted lists rather than #f

[David Kastrup]

David Kastrup <dak@gnu.org> writes:

>> Otherwise, this function looks good to me, but I'd prefer to give it a
>> new name and move it into list.c, rather than extending SRFI-1's
>> 'length+'.

It's not an "extension" of SRFI-1's length+: it just does the same as
the SRFI-1 reference implementation.  It is just a different choice of
working with unspecified behavior than yours.

>> Hmm, coming up with names is hard.  Maybe 'length*'?
>
> Given what cons* (and use of id* in syntax rules) does, the name seems
> inappropriate.  length* would be a good name for
>
> (length* clist1 clist* ... )
>
> returns the length of the shortest finite list in the given lists, #f
> if there is none.  Which would be actually a rather nice building
> block to have for several srfi-1 functions and would basically not
> make us need length+ at all in its implementation.

And that's actually the core of the argument: do we really want to offer
a "length+" that is at best marginally useful for srfi-1 itself?

For a library design, that sounds a lot like "does not eat its own dog
food".  Are we really doing users a favor by filling in the
"unspecified" corners of the srfi-1 in a manner not making for a
coherent whole?

-- 
David Kastrup

bug#17485: [PATCH 1/3] Let length+ return the length of dotted lists rather than #f

[David Kastrup]

David Kastrup <dak@gnu.org> writes:

> David Kastrup <dak@gnu.org> writes:
>
>>> Otherwise, this function looks good to me, but I'd prefer to give it a
>>> new name and move it into list.c, rather than extending SRFI-1's
>>> 'length+'.
>
> It's not an "extension" of SRFI-1's length+: it just does the same as
> the SRFI-1 reference implementation.  It is just a different choice of
> working with unspecified behavior than yours.
>
>>> Hmm, coming up with names is hard.  Maybe 'length*'?
>>
>> Given what cons* (and use of id* in syntax rules) does, the name seems
>> inappropriate.  length* would be a good name for
>>
>> (length* clist1 clist* ... )
>>
>> returns the length of the shortest finite list in the given lists, #f
>> if there is none.  Which would be actually a rather nice building
>> block to have for several srfi-1 functions and would basically not
>> make us need length+ at all in its implementation.
>
> And that's actually the core of the argument: do we really want to offer
> a "length+" that is at best marginally useful for srfi-1 itself?
>
> For a library design, that sounds a lot like "does not eat its own dog
> food".  Are we really doing users a favor by filling in the
> "unspecified" corners of the srfi-1 in a manner not making for a
> coherent whole?

Here is another: if I make length* do the "length of shortest list"
thing, it would be silly _not_ to use it in the multiple-list for-each,
fold, map etc.  So we again get in the situation that the respective
functions would get "lax" in the multi-argument case since length*, if
it were to be used in take-right, _has_ to be lax in the single-argument
case, rendering its behavior again unacceptable for for-each/map/etc and
thus rather pointless as a length* operator.

I am not particularly interested in investing work into further patches
each constituting several days of work getting thrown in the trash, so
I won't even bother making further proposals that can but fail to meet a
set of mutually contradictory design criteria.

-- 
David Kastrup

bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right!

[Mark H Weaver]

David Kastrup <dak@gnu.org> writes:

> * module/srfi/srfi-1.scm (take-right, drop-right, drop-right!): The
>   definitions tended to be overly complicate and/or rely on pushing
>   material on the VM stack, detrimental to scalability for Guile 2.0 and
>   also worse for performance.
>
>   The changed definitions lead to different, more accurate exceptions
>   being raised.  They rely on length+ returning the length of dotted
>   lists, behavior that is not specified by the SRFI-1 definition but
>   available in GUILE.

Your patches look good to me, except that we can't change 'length+' as
you propose.  Instead I'd like to add a lax variant of 'length+' with a
different name, and use that.

I can take care of doing this myself, and will of course still credit
you in whatever manner you prefer, but I've run into a legal problem: we
don't currently have copyright papers for you on file.  Are you willing
to file copyright papers for GUILE?

      Mark

bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right!

[David Kastrup]

Mark H Weaver <mhw@netris.org> writes:

> David Kastrup <dak@gnu.org> writes:
>
>> * module/srfi/srfi-1.scm (take-right, drop-right, drop-right!): The
>>   definitions tended to be overly complicate and/or rely on pushing
>>   material on the VM stack, detrimental to scalability for Guile 2.0 and
>>   also worse for performance.
>>
>>   The changed definitions lead to different, more accurate exceptions
>>   being raised.  They rely on length+ returning the length of dotted
>>   lists, behavior that is not specified by the SRFI-1 definition but
>>   available in GUILE.
>
> Your patches look good to me, except that we can't change 'length+' as
> you propose.  Instead I'd like to add a lax variant of 'length+' with a
> different name, and use that.
>
> I can take care of doing this myself, and will of course still credit
> you in whatever manner you prefer, but I've run into a legal problem: we
> don't currently have copyright papers for you on file.  Are you willing
> to file copyright papers for GUILE?

No problems with that.  Standard request-assign?

At any rate, here is what I would suggest to create: a function
min-length receiving a list of lists (possibly as separate arguments via
a rest argument).

It will return the number of times one can do cdr on every of the given
arguments until at least one of them turns into a list end with nothing
turning into anything but a pair or a list end.

That would allow dotted lists as long as they are longer than any
non-dotted list.  It would still flag when scalars are being used
instead of dotted or undotted lists, the case you are worried about.

That would remain in the spirit of allowing lists of different length as
well as infinite lists, basically "as long as the list part matching the
shortest finite list is usable, let's take it".

While it would not make much sense to actually feed dotted lists into it
(as they will never be usable completely), it would speed up figuring
the minimum list length since there is no point doing cdr 50 times on
list 3 when list 1 has already been tested for being of length 10.

-- 
David Kastrup

bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right!

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 1593 bytes --]

David Kastrup <dak@gnu.org> writes:

> Mark H Weaver <mhw@netris.org> writes:
>
>> I can take care of doing this myself, and will of course still credit
>> you in whatever manner you prefer, but I've run into a legal problem: we
>> don't currently have copyright papers for you on file.  Are you willing
>> to file copyright papers for GUILE?
>
> No problems with that.  Standard request-assign?

request-assign.future would be good, which assigns "PAST AND FUTURE
CHANGES".  Is that what you meant by "Standard request-assign"?

> At any rate, here is what I would suggest to create: a function
> min-length receiving a list of lists (possibly as separate arguments via
> a rest argument).
>
> It will return the number of times one can do cdr on every of the given
> arguments until at least one of them turns into a list end with nothing
> turning into anything but a pair or a list end.

I agree that these are reasonable semantics for validation by 'map' and
'for-each'.  I went ahead and implemented it (attached below).  For
efficiency in the common case, I check for cycles in only one list at a
time.  If a cycle is found, the circular list is discarded and cycle
detection begins on another list.  Let me know if you see a way to
improve it.

However, this is not the procedure needed for 'drop-right',
so we'll still need to add a lax variant of length+.  Maybe
'improper-list-length+'?

I guess that both of these new procedures should go in a new module:
(srfi srfi-1 gnu).  We've used this convention for other SRFI
extensions, e.g. (srfi srfi-9 gnu).

    Regards,
      Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] EXPERIMENTAL Add 'min-length+' --]
[-- Type: text/x-patch, Size: 3470 bytes --]

From 7805c7e91f132e739677ff09e734d7ac181ad213 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Sun, 21 Sep 2014 03:27:48 -0400
Subject: [PATCH] EXPERIMENTAL Add 'min-length+'.

---
 libguile/list.c | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 86 insertions(+)

diff --git a/libguile/list.c b/libguile/list.c
index 669f566..ebb3814 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -31,6 +31,7 @@
 #include "libguile/eval.h"
 
 #include <stdarg.h>
+#include <assert.h>
 
 \f
 /* creating lists */
@@ -218,6 +219,91 @@ SCM_DEFINE (scm_length, "length", 1, 0, 0,
 #undef FUNC_NAME
 
 
+SCM_DEFINE (scm_min_length_plus, "min-length+", 0, 0, 1,
+            (SCM lists),
+	    "Return the number of times one can do cdr on every of the\n"
+            "given arguments until at least one of them turns into null\n"
+            "with nothing turning into anything but a pair or null.  If\n"
+            "any turn into a non-pair, non-null value, it is an error.\n"
+            "If all lists are cyclic, return #f.")
+#define FUNC_NAME s_scm_min_length_plus
+{
+  SCM tortoise;
+  SCM *v;
+  long n;                       /* The number of lists not yet known to be cyclic */
+  long i;                       /* loop variable over lists [0..n] */
+  size_t length_so_far = 0;
+
+  /* Allocate a C vector 'v' to keep the pointers, one per list.  */
+  n = scm_ilength (lists);
+  assert (n >= 0);
+  if (n >= 32)
+    v = (SCM *) scm_malloc (n * sizeof (SCM));
+  else
+    v = (SCM *) alloca (n * sizeof (SCM));
+
+  /* Copy 'lists' to the C vector 'v' */
+  {
+    SCM p = lists;
+    for (i = 0; i < n; i++)
+      {
+        v[i] = SCM_CAR (p);
+        p    = SCM_CDR (p);
+      }
+  }
+
+  /* This loop repeats once time we discover a cycle,
+     at which point we pop v[n-1], decrementing n.  */
+  for (; n > 0; v[--n] = SCM_UNDEFINED)
+    {
+      int toggle = 0;
+
+      tortoise = v[n-1];
+      for (;;)
+        {
+          int found_null = 0;
+
+          /* Advance all pairs in 'v' to their CDRs, while also checking
+             for non-pairs.  If we find the end of a list, set the
+             'done' flag and then continue the loop, to check that every
+             element of 'v' is either a pair or null.  If we find a
+             dotted tail (i.e. a non-null non-pair) in 'v', raise an
+             error immediately.  */
+          for (i = 0; i < n; i++)
+            {
+              if (scm_is_pair (v[i]))
+                v[i] = SCM_CDR (v[i]);
+              else if (scm_is_null (v[i]))
+                found_null = 1;
+              else
+                scm_wrong_type_arg_msg ("min-length+", (i + 1),
+                                        scm_list_ref (lists, scm_from_long (i)),
+                                        "proper or circular list");
+            }
+
+          if (found_null)
+            return scm_from_size_t (length_so_far);
+
+          length_so_far++;
+
+          /* Once every two turns, advance the tortoise
+             and check for a cycle.  */
+          if (toggle)
+            {
+              tortoise = SCM_CDR (tortoise);
+              if (scm_is_eq (tortoise, v[n-1]))
+                break;          /* We found a cycle */
+            }
+          toggle = !toggle;
+        }
+    }
+
+  /* We found cycles in every list, so return #f.  */
+  return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+
 \f
 /* appending lists */
 
-- 
1.8.4

bug#17485: [PATCH 2/3] Rewrite take-right, drop-right, drop-right!

[David Kastrup]

Mark H Weaver <mhw@netris.org> writes:

> David Kastrup <dak@gnu.org> writes:
>
>> Mark H Weaver <mhw@netris.org> writes:
>>
>>> I can take care of doing this myself, and will of course still credit
>>> you in whatever manner you prefer, but I've run into a legal problem: we
>>> don't currently have copyright papers for you on file.  Are you willing
>>> to file copyright papers for GUILE?
>>
>> No problems with that.  Standard request-assign?
>
> request-assign.future would be good, which assigns "PAST AND FUTURE
> CHANGES".  Is that what you meant by "Standard request-assign"?
>
>> At any rate, here is what I would suggest to create: a function
>> min-length receiving a list of lists (possibly as separate arguments via
>> a rest argument).
>>
>> It will return the number of times one can do cdr on every of the given
>> arguments until at least one of them turns into a list end with nothing
>> turning into anything but a pair or a list end.
>
> I agree that these are reasonable semantics for validation by 'map' and
> 'for-each'.  I went ahead and implemented it (attached below).  For
> efficiency in the common case, I check for cycles in only one list at a
> time.  If a cycle is found, the circular list is discarded and cycle
> detection begins on another list.  Let me know if you see a way to
> improve it.

Don't walk the lists in synch.  That's the worst possible way to do
stuff regarding memory locality.

Instead do the lists one by one.  Keep in mind the length of the
shortest list so far and whether any list of that length was improper.
Once you walked the length of the shortest list so far, you can abort
the current list.  Since cyclical lists will tend to be very short (and
not uncommon for the multiple-list case), I'd probably let the tortoise
run even when it is known that there is already one finite list.

Walking the lists in synch is only an advantage when there are several
finite lists and later ones are considerably shorter than preceding
ones.  Not a likely use case.

The work horse would be something like "limited-length" which gets a
list and a previous limit, where #f means "no limit and/or circular",
2*n is used for proper lists and 2*n-1 for improper lists (in order to
dominate the minimum in the case of equal lengths of proper and improper
lists).

The first idea was to use n and n-1/2, but since length comparisons are
done for every element, 2n and 2n-1 should be cheaper.

If the minimum after the last list is odd, flag an error, else divide by
2 and return the result.

-- 
David Kastrup

bug#17485: (srfi srfi-1) reduce-right does not scale, version 2.0.9

[Andy Wingo]

Hi,

On Tue 13 May 2014 12:47, David Kastrup <dak@gnu.org> writes:

> The following code results in an error:
>
> (use-modules (srfi srfi-1))
> (reduce-right + 0 (make-list 10000 1))
>
> Backtrace:
> In srfi/srfi-1.scm:
>  379: 19 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 18 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 17 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 16 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 15 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 14 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 13 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 12 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 11 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 10 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 9 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 8 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 7 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 6 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 5 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 4 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 3 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 2 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 1 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>  379: 0 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>
> srfi/srfi-1.scm:379:31: In procedure recur:
> srfi/srfi-1.scm:379:31: Throw to key `vm-error' with args `(vm-run "VM: Stack overflow" ())'.

On the 2.2 series this problem does not occur because there is no stack
limit.  Mark if you would like to fix this on 2.0 in a different way, go
ahead.  Otherwise we can close.

I think on 2.0 that this might be an OK workaround:

 (define (reduce-right f ridentity lst)
   (reduce f ridentity (reverse lst)))

Thoughts?

Andy

bug#17485: (srfi srfi-1) reduce-right does not scale, version 2.0.9

[David Kastrup]

Andy Wingo <wingo@pobox.com> writes:

> Hi,
>
> On Tue 13 May 2014 12:47, David Kastrup <dak@gnu.org> writes:
>
>> The following code results in an error:
>>
>> (use-modules (srfi srfi-1))
>> (reduce-right + 0 (make-list 10000 1))
>>
>> Backtrace:
>> In srfi/srfi-1.scm:
>>  379: 19 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 18 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 17 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 16 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 15 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 14 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 13 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 12 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 11 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 10 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 9 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 8 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 7 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 6 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 5 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 4 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 3 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 2 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 1 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>  379: 0 [recur (1 1 1 1 1 1 1 1 1 ...) (1 1 1 1 1 1 1 1 1 ...)]
>>
>> srfi/srfi-1.scm:379:31: In procedure recur:
>> srfi/srfi-1.scm:379:31: Throw to key `vm-error' with args `(vm-run
>> "VM: Stack overflow" ())'.
>
> On the 2.2 series this problem does not occur because there is no stack
> limit.  Mark if you would like to fix this on 2.0 in a different way, go
> ahead.  Otherwise we can close.
>
> I think on 2.0 that this might be an OK workaround:
>
>  (define (reduce-right f ridentity lst)
>    (reduce f ridentity (reverse lst)))
>
> Thoughts?

Traversing lst in reverse without additional O(n) storage would require
working on (reverse! lst), fixing up the list afterwards.  Using
reverse!  also has the advantage that the list? predicate check does not
require the turtle/hare traversal.

The downside, of course, is that for something like reduce-right,
temporary reversal of lst would be an unexpected side effect not working
well with multithreading or read-only memory.

So if we don't store the inverse list in-space, it needs to be either a
copy in heap (reverse) or stack (recursion).  Stack allocation is likely
cheaper in execution time (though the total memory cost depends on the
stack frame size taken per call).  The limited stack size on 2.0 does
not seem like a good fit, however.  Which makes your workaround seem
like the best option.

I don't like that then both reduce and reverse check for listness.  But
that's a different topic.

-- 
David Kastrup

bug#17485: (srfi srfi-1) reduce-right does not scale, version 2.0.9

[Andy Wingo]

On Tue 21 Jun 2016 17:31, David Kastrup <dak@gnu.org> writes:

> Andy Wingo <wingo@pobox.com> writes:
>
>> I think on 2.0 that this might be an OK workaround:
>>
>>  (define (reduce-right f ridentity lst)
>>    (reduce f ridentity (reverse lst)))
>
> So if we don't store the inverse list in-space, it needs to be either a
> copy in heap (reverse) or stack (recursion).  Stack allocation is likely
> cheaper in execution time (though the total memory cost depends on the
> stack frame size taken per call).  The limited stack size on 2.0 does
> not seem like a good fit, however.  Which makes your workaround seem
> like the best option.

Applied this fix to stable-2.0.  Thanks for the report.

Andy

bug#17485: Ugh, well...

[David Kastrup]

Sorry, I really should have checked the whole bug report before agreeing
with the resolution.  The actual problem triggering the stack overflow
problem in the original report was not even in reduce-right but rather
in drop-right.

drop-right is still defective im the original manner.

So this is "fixing" only the titular symptom of the quite larger
underlying set of problems underlying this issue report.

-- 
David Kastrup

bug#17485: Ugh, well...

[Andy Wingo]

On Tue 12 Jul 2016 09:43, David Kastrup <dak@gnu.org> writes:

> Sorry, I really should have checked the whole bug report before agreeing
> with the resolution.  The actual problem triggering the stack overflow
> problem in the original report was not even in reduce-right but rather
> in drop-right.
>
> drop-right is still defective im the original manner.
>
> So this is "fixing" only the titular symptom of the quite larger
> underlying set of problems underlying this issue report.

Fixed drop-right as well.

Andy