guile/guile-core/srfi ChangeLog srfi-1.scm

[Martin Grabmueller]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Martin Grabmueller <address@hidden>     01/07/03 09:19:23

Modified files:
        guile-core/srfi: ChangeLog srfi-1.scm 

Log message:
        * srfi-1.scm (list-tabulate): Do not go into infinite loop for
        invalid arguments.  Same fix for several other procedures (do not
        use zero?, use <= 0).

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/srfi/ChangeLog.diff?cvsroot=OldCVS&tr1=1.39&tr2=1.40&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/srfi/srfi-1.scm.diff?cvsroot=OldCVS&tr1=1.4&tr2=1.5&r1=text&r2=text

Patches:
Index: guile/guile-core/srfi/ChangeLog
diff -u guile/guile-core/srfi/ChangeLog:1.39 
guile/guile-core/srfi/ChangeLog:1.40
--- guile/guile-core/srfi/ChangeLog:1.39        Tue Jul  3 08:35:08 2001
+++ guile/guile-core/srfi/ChangeLog     Tue Jul  3 09:19:23 2001
@@ -1,7 +1,8 @@
 2001-07-03  Martin Grabmueller  <address@hidden>
 
        * srfi-1.scm (list-tabulate): Do not go into infinite loop for
-       invalid arguments.
+       invalid arguments.  Same fix for several other procedures (do not
+       use zero?, use <= 0).
 
 2001-07-02  Martin Grabmueller  <address@hidden>
 
Index: guile/guile-core/srfi/srfi-1.scm
diff -u guile/guile-core/srfi/srfi-1.scm:1.4 
guile/guile-core/srfi/srfi-1.scm:1.5
--- guile/guile-core/srfi/srfi-1.scm:1.4        Tue Jul  3 08:35:08 2001
+++ guile/guile-core/srfi/srfi-1.scm    Tue Jul  3 09:19:23 2001
@@ -347,17 +347,17 @@
 
 (define (take x i)
   (let lp ((n i) (l x) (acc '()))
-    (if (zero? n)
+    (if (<= n 0)
       (reverse! acc)
       (lp (- n 1) (cdr l) (cons (car l) acc)))))
 (define (drop x i)
   (let lp ((n i) (l x))
-    (if (zero? n)
+    (if (<= n 0)
       l
       (lp (- n 1) (cdr l)))))
 (define (take-right flist i)
   (let lp ((n i) (l flist))
-    (if (zero? n)
+    (if (<= n 0)
       (let lp0 ((s flist) (l l))
        (if (null? l)
          s
@@ -366,7 +366,7 @@
   
 (define (drop-right flist i)
   (let lp ((n i) (l flist))
-    (if (zero? n)
+    (if (<= n 0)
       (let lp0 ((s flist) (l l) (acc '()))
        (if (null? l)
          (reverse! acc)
@@ -374,20 +374,20 @@
       (lp (- n 1) (cdr l)))))
 
 (define (take! x i)
-  (if (zero? i)
+  (if (<= i 0)
     '()
     (let lp ((n (- i 1)) (l x))
-      (if (zero? n)
+      (if (<= n 0)
        (begin 
          (set-cdr! l '())
          x)
        (lp (- n 1) (cdr l))))))
 
 (define (drop-right! flist i)
-  (if (zero? i)
+  (if (<= i 0)
     flist
     (let lp ((n (+ i 1)) (l flist))
-      (if (zero? n)
+      (if (<= n 0)
        (let lp0 ((s flist) (l l))
          (if (null? l)
            (begin
@@ -400,15 +400,15 @@
 
 (define (split-at x i)
   (let lp ((l x) (n i) (acc '()))
-    (if (zero? n)
+    (if (<= n 0)
       (values (reverse! acc) l)
       (lp (cdr l) (- n 1) (cons (car l) acc)))))
 
 (define (split-at! x i)
-  (if (zero? i)
+  (if (<= i 0)
     (values '() x)
     (let lp ((l x) (n (- i 1)))
-      (if (zero? n)
+      (if (<= n 0)
        (let ((tmp (cdr l)))
          (set-cdr! l '())
          (values x tmp))