add vector-map, vector-for-each, string-map, string-for-each

This commit is contained in:
Yuito Murase 2013-11-29 01:50:10 +09:00
parent 098e9bdb43
commit 3c79c0df00
1 changed files with 40 additions and 0 deletions

View File

@ -535,6 +535,46 @@
res)) res))
(fold bytevector-append-2-inv #() vs)) (fold bytevector-append-2-inv #() vs))
;;; 6.10 control features
(define (string-map f v . vs)
(let* ((len (fold min (string-length v) (map string-length vs)))
(vec (make-string len)))
(let loop ((n 0))
(if (= n len)
vec
(begin (string-set! vec n
(apply f (cons (string-ref v n)
(map (lambda (v) (string-ref v n)) vs))))
(loop (+ n 1)))))))
(define (string-for-each f v . vs)
(let* ((len (fold min (string-length v) (map string-length vs))))
(let loop ((n 0))
(unless (= n len)
(apply f (string-ref v n)
(map (lambda (v) (string-ref v n)) vs))
(loop (+ n 1))))))
(define (vector-map f v . vs)
(let* ((len (fold min (vector-length v) (map vector-length vs)))
(vec (make-vector len)))
(let loop ((n 0))
(if (= n len)
vec
(begin (vector-set! vec n
(apply f (cons (vector-ref v n)
(map (lambda (v) (vector-ref v n)) vs))))
(loop (+ n 1)))))))
(define (vector-for-each f v . vs)
(let* ((len (fold min (vector-length v) (map vector-length vs))))
(let loop ((n 0))
(unless (= n len)
(apply f (vector-ref v n)
(map (lambda (v) (vector-ref v n)) vs))
(loop (+ n 1))))))
;;; hygienic macros ;;; hygienic macros
(define (walk f obj) (define (walk f obj)