Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge pull request #945 from ekaitz-zarraga/concatenate!

Browse source 
Fix #944: concatenate! work with empty lists in any position
This commit is contained in:
Alex Shinn 2024-01-09 09:42:27 +09:00 • committed by GitHub
commit cc6a3d10e5
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 11 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lib/srfi/1/misc.scm
View file

@ -15,12 +15,13 @@
(define (concatenate! lists) (define (concatenate! lists)
(if (null? lists) (if (null? lists)
'() '()
(let lp ((ls lists)) (fold (lambda (el acc)
(cond ((not (pair? (cdr ls))) (cond
(car lists)) ((null? acc) el)
(else ((null? el) acc)
(set-cdr! (last-pair (car ls)) (cadr ls)) (else (begin (set-cdr! (last-pair acc) el) acc))))
(lp (cdr ls))))))) (car lists)
(cdr lists))))
(define (append-reverse rev tail) (define (append-reverse rev tail)
(if (null? rev) tail (append-reverse (cdr rev) (cons (car rev) tail)))) (if (null? rev) tail (append-reverse (cdr rev) (cons (car rev) tail))))

4
lib/srfi/1/test.sld
View file

@ -77,6 +77,10 @@
(test 'a (append '() 'a)) (test 'a (append '() 'a))
(test '(x y) (append '(x y))) (test '(x y) (append '(x y)))
(test '() (append)) (test '() (append))
(test (list 'a) (append! '() (list 'a)))
(test (list 'a 'b) (append! (list 'a) '() '() (list 'b)))
(test (list 'x 'y) (append! (list 'x 'y)))
(test '() (append!))
(test '(c b a) (reverse '(a b c))) (test '(c b a) (reverse '(a b c)))
(test '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f))))) (test '((e (f)) d (b c) a) (reverse '(a (b c) d (e (f)))))
(test '((one 1 odd) (two 2 even) (three 3 odd)) (zip '(one two three) '(1 2 3) '(odd even odd even odd even odd even))) (test '((one 1 odd) (two 2 even) (three 3 odd)) (zip '(one two three) '(1 2 3) '(odd even odd even odd even odd even)))