From cfd95cc93c99cd697657c156743d8beb7151add6 Mon Sep 17 00:00:00 2001
From: ben <benjaminlgreenman@gmail.com>
Date: Wed, 2 Mar 2016 12:26:52 -0500
Subject: [PATCH] [vector] tests for let-vector:

---
 test/vector-pass.rkt | 22 +++++++++++++++++
 vector.rkt           | 57 +++++++++++++++++++++++++-------------------
 2 files changed, 54 insertions(+), 25 deletions(-)

diff --git a/test/vector-pass.rkt b/test/vector-pass.rkt
index a7100f4..7dc3501 100644
--- a/test/vector-pass.rkt
+++ b/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 ()
diff --git a/vector.rkt b/vector.rkt
index 31c8201..3649de3 100644
--- a/vector.rkt
+++ b/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
-  #:attributes (vector-length)
-  (pattern [e* ...]
-   #:with len (parse-vector-length #'(e* ...))
+(begin-for-syntax (define-syntax-class vector/length
+  #:attributes (expanded length)
+  (pattern 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)
-    (free-id-table-set! id+vector-length
-                        #'name
-                        (syntax-e #'v.vector-length))
-    #'(define name v)]
+   [(_ name:id v:vector/length)
+    (free-id-table-set! id+vector-length #'name (syntax-e #'v.length))
+    #'(define name v.expanded)]
    [(_ e* ...)
     #'(define e* ...)]))
 
 (define-syntax (let-vector: stx)
   (syntax-parse stx
-   [(_ ([name:id v:literal-vector]) e* ...)
-    #'(let ([name v])
-        (let-syntax ([name (make-rename-transformer
-                             (syntax-property #'name
-                                              vector-length-key
-                                              #'v.vector-length))])
+   [(_ ([name*:id v*:vector/length] ...) e* ...)
+    #'(let ([name* v*.expanded] ...)
+        (let-syntax ([name* (make-rename-transformer
+                              (syntax-property #'name*
+                                               vector-length-key
+                                               '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)
-    #:when (printf "ref: getting langth for ~a\n" (syntax->datum #'v))
-    #: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))
+   [(_ v:vector/length i:nat)
+    (unless (< (syntax-e #'i) (syntax-e #'v.length))
       (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])]))
 
-