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

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