mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +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> 2001-07-03 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
* srfi-1.scm (list-tabulate): Do not go into infinite loop for * 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> 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) (define (take x i)
(let lp ((n i) (l x) (acc '())) (let lp ((n i) (l x) (acc '()))
(if (zero? n) (if (<= n 0)
(reverse! acc) (reverse! acc)
(lp (- n 1) (cdr l) (cons (car l) acc))))) (lp (- n 1) (cdr l) (cons (car l) acc)))))
(define (drop x i) (define (drop x i)
(let lp ((n i) (l x)) (let lp ((n i) (l x))
(if (zero? n) (if (<= n 0)
l l
(lp (- n 1) (cdr l))))) (lp (- n 1) (cdr l)))))
(define (take-right flist i) (define (take-right flist i)
(let lp ((n i) (l flist)) (let lp ((n i) (l flist))
(if (zero? n) (if (<= n 0)
(let lp0 ((s flist) (l l)) (let lp0 ((s flist) (l l))
(if (null? l) (if (null? l)
s s
@ -366,7 +366,7 @@
(define (drop-right flist i) (define (drop-right flist i)
(let lp ((n i) (l flist)) (let lp ((n i) (l flist))
(if (zero? n) (if (<= n 0)
(let lp0 ((s flist) (l l) (acc '())) (let lp0 ((s flist) (l l) (acc '()))
(if (null? l) (if (null? l)
(reverse! acc) (reverse! acc)
@ -374,20 +374,20 @@
(lp (- n 1) (cdr l))))) (lp (- n 1) (cdr l)))))
(define (take! x i) (define (take! x i)
(if (zero? i) (if (<= i 0)
'() '()
(let lp ((n (- i 1)) (l x)) (let lp ((n (- i 1)) (l x))
(if (zero? n) (if (<= n 0)
(begin (begin
(set-cdr! l '()) (set-cdr! l '())
x) x)
(lp (- n 1) (cdr l)))))) (lp (- n 1) (cdr l))))))
(define (drop-right! flist i) (define (drop-right! flist i)
(if (zero? i) (if (<= i 0)
flist flist
(let lp ((n (+ i 1)) (l flist)) (let lp ((n (+ i 1)) (l flist))
(if (zero? n) (if (<= n 0)
(let lp0 ((s flist) (l l)) (let lp0 ((s flist) (l l))
(if (null? l) (if (null? l)
(begin (begin
@ -400,15 +400,15 @@
(define (split-at x i) (define (split-at x i)
(let lp ((l x) (n i) (acc '())) (let lp ((l x) (n i) (acc '()))
(if (zero? n) (if (<= n 0)
(values (reverse! acc) l) (values (reverse! acc) l)
(lp (cdr l) (- n 1) (cons (car l) acc))))) (lp (cdr l) (- n 1) (cons (car l) acc)))))
(define (split-at! x i) (define (split-at! x i)
(if (zero? i) (if (<= i 0)
(values '() x) (values '() x)
(let lp ((l x) (n (- i 1))) (let lp ((l x) (n (- i 1)))
(if (zero? n) (if (<= n 0)
(let ((tmp (cdr l))) (let ((tmp (cdr l)))
(set-cdr! l '()) (set-cdr! l '())
(values x tmp)) (values x tmp))