conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #263 from omasanori/srfi43 

Make vector-map{,!} SRFI 43-compliant
This commit is contained in:
Yuichi Nishiwaki 2015-05-16 02:07:41 +09:00
parent a8520fe595 52624460cd
commit d2842dd579
1 changed files with 16 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
contrib/10.srfi/srfi/43.scm
View File

@ -1,5 +1,5 @@
(define-library (srfi 43) (define-library (srfi 43)
(import (scheme base) (import (except (scheme base) vector-map)
(srfi 8)) (srfi 8))
;; # Constructors ;; # Constructors
@ -92,16 +92,28 @@
(map (lambda (v) (vector-ref v count)) vects)) (map (lambda (v) (vector-ref v count)) vects))
(- count 1)))))) (- count 1))))))
(define (vector-map! f vec . vects) (define (vector-map f vec . vects)
(let* ((vects (cons vec vects)) (let* ((vects (cons vec vects))
(veclen (apply min (map vector-length vects))) (veclen (apply min (map vector-length vects)))
(new-vect (make-vector veclen))) (new-vect (make-vector veclen)))
(let rec ((count 0))
(if (= count veclen)
new-vect
(begin
(vector-set! new-vect count
(apply f count (map (lambda (v) (vector-ref v count))
vects)))
(rec (+ 1 count)))))))
(define (vector-map! f vec . vects)
(let* ((vects (cons vec vects))
(veclen (apply min (map vector-length vects))))
(let rec ((count 0)) (let rec ((count 0))
(if (< count veclen) (if (< count veclen)
(begin (begin
(vector-set! vec count (vector-set! vec count
(apply f (map (lambda (v) (vector-ref v count)) (apply f count (map (lambda (v) (vector-ref v count))
vects))) vects)))
(rec (+ 1 count))))))) (rec (+ 1 count)))))))
(define (vector-count pred? vec . vects) (define (vector-count pred? vec . vects)