Merge pull request #263 from omasanori/srfi43

Make vector-map{,!} SRFI 43-compliant
picrin-scheme · May 15, 2015 · d2842dd · d2842dd
2 parents a8520fe + 5262446
commit d2842dd
Showing 1 changed file with 16 additions and 4 deletions.
diff --git a/contrib/10.srfi/srfi/43.scm b/contrib/10.srfi/srfi/43.scm
@@ -1,5 +1,5 @@
 (define-library (srfi 43)
-  (import (scheme base)
+  (import (except (scheme base) vector-map)
           (srfi 8))
 
   ;; # Constructors
@@ -92,16 +92,28 @@
                         (map (lambda (v) (vector-ref v count)) vects))
                  (- count 1))))))
 
-  (define (vector-map! f vec . vects)
+  (define (vector-map f vec . vects)
     (let* ((vects (cons vec vects))
            (veclen (apply min (map vector-length vects)))
            (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))
         (if (< count veclen)
             (begin
               (vector-set! vec count
-                           (apply f (map (lambda (v) (vector-ref v count))
-                                         vects)))
+                           (apply f count (map (lambda (v) (vector-ref v count))
+                                               vects)))
               (rec (+ 1 count)))))))
 
   (define (vector-count pred? vec . vects)