[vector] tests for let-vector:

test/vector-pass.rkt

@@ -2,6 +2,7 @@
 
 (module+ test
   (require
+    trivial/math
     trivial/vector
     typed/rackunit)
 
@@ -58,6 +59,27 @@
     61)
 
   ;; -- vector-length:
+  (check-equal?
+    (vector-length: '#()) 0)
+  (check-equal?
+    (vector-length: (vector 1 2 2)) 3)
+  (check-equal?
+    (ann (-: (vector-length: (vector 5 5 5 5 5)) 4)
+         One)
+    1)
+  (let-vector: ([v1 (vector 2 3 4)]
+                [v2 (vector 4 3 2)])
+    (check-equal?
+      (ann (+: 1 (-: (*: 5 (vector-length: v1)) (+: (*: 4 3) (vector-length: v2))))
+           One)
+      1))
+  (let ()
+    (define-vector: v1 (vector 2 3 4))
+    (define-vector: v2 (vector 4 3 2))
+    (check-equal?
+      (ann (*: 5 (-: (vector-length: v1) (*: 1 1 (vector-length: v2) 1)))
+           Zero)
+      0))
 
   ;; -- define-vector:
   (let ()

vector.rkt

@@ -5,7 +5,7 @@
 (provide
   define-vector:
   let-vector:
-  ;vector-length:
+  vector-length:
   vector-ref:
   ;vector-set!:
   ;vector-map:
@@ -28,6 +28,7 @@
     syntax/id-table
     syntax/parse
     syntax/stx
+    trivial/private/common
   ))
 
 ;; =============================================================================
@@ -36,32 +37,32 @@
 (define-for-syntax errloc-key 'vector:)
 (define-for-syntax id+vector-length (make-free-id-table))
 
-(begin-for-syntax (define-syntax-class literal-vector
+(begin-for-syntax (define-syntax-class vector/length
-  #:attributes (vector-length)
+  #:attributes (expanded length)
-  (pattern [e* ...]
+  (pattern e
-   #:with len (parse-vector-length #'(e* ...))
+   #:with e+ (expand-expr #'e)
+   #:with len (parse-vector-length #'e+)
    #:when (syntax-e #'len)
-   #:attr vector-length #'len)
+   #:attr expanded #'e+
+   #:attr length #'len)
 ))
 
 (define-syntax (define-vector: stx)
   (syntax-parse stx
-   [(_ name:id v:literal-vector)
+   [(_ name:id v:vector/length)
-    (free-id-table-set! id+vector-length
+    (free-id-table-set! id+vector-length #'name (syntax-e #'v.length))
-                        #'name
+    #'(define name v.expanded)]
-                        (syntax-e #'v.vector-length))
-    #'(define name v)]
    [(_ e* ...)
     #'(define e* ...)]))
 
 (define-syntax (let-vector: stx)
   (syntax-parse stx
-   [(_ ([name:id v:literal-vector]) e* ...)
+   [(_ ([name*:id v*:vector/length] ...) e* ...)
-    #'(let ([name v])
+    #'(let ([name* v*.expanded] ...)
-        (let-syntax ([name (make-rename-transformer
+        (let-syntax ([name* (make-rename-transformer
-                             (syntax-property #'name
+                              (syntax-property #'name*
-                                              vector-length-key
+                                               vector-length-key
-                                              #'v.vector-length))])
+                                               'v*.length))] ...)
           e* ...))]
    [(_ e* ...)
     #'(let e* ...)]))
@@ -72,17 +73,23 @@
     (format "Index out-of-bounds: ~a" i)
     v))
 
+(define-syntax (vector-length: stx)
+  (syntax-parse stx
+   [(_ v:vector/length)
+    (syntax/loc stx 'v.length)]
+   [_:id
+    (syntax/loc stx vector-length)]
+   [(_ e* ...)
+    (syntax/loc stx (vector-length e* ...))]))
 
 (define-syntax (vector-ref: stx)
   (syntax-parse stx
-   [(_ v i:nat)
+   [(_ v:vector/length i:nat)
-    #:when (printf "ref: getting langth for ~a\n" (syntax->datum #'v))
+    (unless (< (syntax-e #'i) (syntax-e #'v.length))
-    #:with len (parse-vector-length #'v)
-    #:when (printf "ref: got langth ~a\n" (syntax->datum #'len))
-    #:when (syntax-e #'len)
-    (unless (< (syntax-e #'i) (syntax-e #'len))
       (vector-ref-error (syntax-e #'v) (syntax-e #'i)))
-    (syntax/loc stx (unsafe-vector-ref v i))]
+    (syntax/loc stx (unsafe-vector-ref v.expanded i))]
+   [_:id
+    (syntax/loc stx vector-ref)]
    [(_ e* ...)
     (syntax/loc stx (vector-ref e* ...))]))
 
@@ -100,6 +107,7 @@
       [(~or '#(e* ...)
             #(e* ...)
             ;; TODO #{} #[] #6{} ...
+            (_ vector e* ...) ;; TODO the _ should be matching #%app
             (vector e* ...))
        (length (syntax->list #'(e* ...)))]
       [(make-vector n:nat e* ...)
@@ -108,4 +116,3 @@
        (syntax-e #'n)]
       [_ #f])]))
 
-