[vector] vector-map

test/vector-fail.rkt

@@ -21,6 +21,12 @@
 
   (vector-set!: (vector 0) 0 "hello") ;; Strong update
 
+  (vector-ref: (vector-map: (lambda (x) x) (vector #t "ha")) 20)
+
+  (vector-ref:
+    (vector-map: add1 (vector-map: add1 (vector-map: add1 (vector 0 0 0))))
+    3)
+
 )))
 
 ;; -----------------------------------------------------------------------------

test/vector-pass.rkt

@@ -134,6 +134,47 @@
         (lambda ()
           ((lambda ([f : (-> (Vectorof Any) Natural Any Void)])
             (f (vector 0 1 2) 10 9)) vector-set!:))))
+ ;)
+
+ ;(test-suite "vector-map:"
+   (test-case "vector/length map"
+     (check-equal? (vector-map: add1 (vector 1)) (vector 2)))
+
+   (test-case "vector/length map via let"
+     (check-equal?
+       (let-vector: ([v (vector (vector 1) (vector 2 2)
+                                (vector 3 3 3) (vector 4 4 4 4))])
+         (vector-map: vector-length: v))
+       (vector 1 2 3 4)))
+
+   (test-case "map^3"
+     (check-equal?
+       (vector-map: add1 (vector-map: add1 (vector-map: add1 (vector 0 0 0))))
+       (vector 3 3 3)))
+
+   (test-case "plain map"
+     (check-equal?
+       ((lambda ([v : (Vectorof (Vectorof Any))])
+         (vector-map: vector-length: v))
+        (vector (vector 1) (vector 2 2) (vector 3 3 3) (vector 4 4 4 4)))
+       (vector 1 2 3 4)))
+
+   (test-case "higher-order map pass"
+     (check-equal?
+       ((lambda ([f : (-> (-> Symbol String) (Vectorof Symbol) (Vectorof String))])
+         (f symbol->string '#(x yy z)))
+        vector-map:)
+       (vector "x" "yy" "z")))
+
+   (test-case "higher-order map fail"
+     (check-exn exn:fail:contract?
+       (lambda ()
+         ((lambda ([f : (-> (-> Integer Integer) (Vectorof Integer) (Vectorof Integer))])
+           (vector-ref: (f add1 (vector 0 0)) 3))
+          vector-map:))))
+ ;)
+
+  ;(test-suite "vector-map!:"
   ;)
 
   ;; -- define-vector:

vector.rkt

@@ -8,9 +8,12 @@
   vector-length:
   vector-ref:
   vector-set!:
-  ;vector-map:
+  vector-map:
   ;vector-append:
   ;vector->list
+  ;vector->immutable-vector
+  ;vector-fill!
+  ;
 
   ;; TODO and a few more
 
@@ -24,6 +27,7 @@
   (only-in racket/unsafe/ops
     unsafe-vector-set!
     unsafe-vector-ref)
+  racket/vector
   (for-syntax
     typed/racket/base
     syntax/id-table
@@ -105,8 +109,29 @@
    [(_ e* ...)
     (syntax/loc stx (vector-set! e* ...))]))
 
+(define-syntax (vector-map: stx)
+  (syntax-parse stx
+   [(_ f v:vector/length)
+    #:with (i* ...) (for/list ([i (in-range (syntax-e #'v.length))]) i)
+    ;; TODO need to set syntax property?
+    #:with v+ (syntax-property
+                (if (small-vector-size? (syntax-e #'v.length))
+                  (syntax/loc stx (vector (f (unsafe-vector-ref v.expanded 'i*)) ...))
+                  (syntax/loc stx (build-vector 'v.length (lambda ([i : Integer])
+                                                            (unsafe-vector-ref v.expanded i)))))
+                vector-length-key
+                (syntax-e #'v.length))
+    (syntax/loc stx v+)]
+   [_:id
+    (syntax/loc stx vector-map)]
+   [(_ e* ...)
+    (syntax/loc stx (vector-map e* ...))]))
+
 ;; -----------------------------------------------------------------------------
 
+(define-for-syntax (small-vector-size? n)
+  (< n 101))
+
 ;; Assume `stx` is creating a vector; get the length of the vector to-be-made
 (define-for-syntax (parse-vector-length stx)
   (cond
@@ -122,9 +147,13 @@
             (_ vector e* ...) ;; TODO the _ should be matching #%app
             (vector e* ...))
        (length (syntax->list #'(e* ...)))]
-      [(make-vector n:nat e* ...)
-       (syntax-e #'n)]
-      [(build-vector n:nat f)
-       (syntax-e #'n)]
-      [_ #f])]))
+      [(~or (make-vector n e* ...)
+            (_ make-vector n e* ...)
+            (build-vector n e* ...)
+            (_ build-vector n e* ...))
+       (if (syntax-transforming?)
+         (quoted-stx-value? (expand-expr #'n))
+         (and (exact-nonnegative-integer? (syntax-e #'n)) (syntax-e #'n)))]
+      [_
+       #f])]))