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

fixing uvector-reverse-copy (issue #676); ungeneralize unfold to take exactly one seed

Browse source
This commit is contained in:
Alex Shinn 2020-08-08 16:14:57 +09:00
parent 90f0425c37
commit ffeb960997
1 changed files with 16 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
lib/srfi/160/uvector.scm
View file

@ -30,41 +30,43 @@
(define (vector . ls) (define (vector . ls)
(list->uvector ls)) (list->uvector ls))
(define (uvector-unfold f len . o) (define (uvector-unfold f len seed)
(let ((res (make-uvector len))) (let ((res (make-uvector len)))
(let lp ((i 0) (seeds o)) (let lp ((i 0) (seed seed))
(if (>= i len) (if (>= i len)
res res
(call-with-values (lambda () (apply f i seeds)) (call-with-values (lambda () (f i seed))
(lambda (x . seeds) (lambda (x seed)
(uvector-set! res i x) (uvector-set! res i x)
(lp (+ i 1) seeds))))))) (lp (+ i 1) seed)))))))
(define (uvector-unfold-right f len . o) (define (uvector-unfold-right f len seed)
(let ((res (make-uvector len))) (let ((res (make-uvector len)))
(let lp ((i (- len 1)) (seeds o)) (let lp ((i (- len 1)) (seed seed))
(if (< i 0) (if (< i 0)
res res
(call-with-values (lambda () (apply f i seeds)) (call-with-values (lambda () (f i seed))
(lambda (x . seeds) (lambda (x seed)
(uvector-set! res i x) (uvector-set! res i x)
(lp (- i 1) seeds))))))) (lp (- i 1) seed)))))))
(define (vector-copy vec . o) (define (vector-copy vec . o)
(let ((start (if (pair? o) (car o) 0)) (let ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o))) (end (if (and (pair? o) (pair? (cdr o)))
(cadr o) (cadr o)
(uvector-length vec)))) (uvector-length vec))))
(uvector-unfold (lambda (i) (uvector-ref vec (+ i start))) (uvector-unfold (lambda (i _) (values (uvector-ref vec (+ i start)) _))
(- end start)))) (- end start)
#f)))
(define (vector-reverse-copy vec . o) (define (vector-reverse-copy vec . o)
(let ((start (if (pair? o) (car o) 0)) (let ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o))) (end (if (and (pair? o) (pair? (cdr o)))
(cadr o) (cadr o)
(uvector-length vec)))) (uvector-length vec))))
(uvector-unfold (lambda (i) (uvector-ref vec (- end (+ i start)))) (uvector-unfold (lambda (i _) (values (uvector-ref vec (- end i 1)) _))
(- end start)))) (- end start)
#f)))
(define (vector-concatenate vecs) (define (vector-concatenate vecs)
(let* ((len (apply + (map uvector-length vecs))) (let* ((len (apply + (map uvector-length vecs)))