mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

* srfi-1.scm (list-tabulate): Do not go into infinite loop for

Browse source 
invalid arguments.  Same fix for several other procedures (do not
	use zero?, use <= 0).
This commit is contained in:
Martin Grabmüller 2001-07-03 16:19:23 +00:00
parent 018adcae03
commit e800aa0482
2 changed files with 13 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

3
srfi/ChangeLog
View file

@ -1,7 +1,8 @@
2001-07-03 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
* 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 <mgrabmue@cs.tu-berlin.de>

22
srfi/srfi-1.scm
View file

@ -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))