[vector] checkpoint: parse-vector-length

test/vector-pass.rkt

@@ -0,0 +1,59 @@
+#lang typed/racket/base
+
+(module+ test
+  (require
+    trivial/vector
+    typed/rackunit)
+
+  (require/typed (for-template trivial/vector)
+    (parse-vector-length (-> Syntax (Option Natural))))
+
+  ;; -- parse-vector-length
+  ;; --- '#
+  (check-equal?
+    (parse-vector-length #'#())
+    0)
+;  (check-equal?
+;    (parse-vector-length #`#,'#(1 2))
+;    2)
+  (check-equal?
+    (parse-vector-length #'#(1 2 3 4))
+    4)
+  (check-equal?
+    (parse-vector-length #'#(a b c e s aue d al))
+    8)
+  ;; --- vector
+  (check-equal?
+    (parse-vector-length #'(vector))
+    0)
+  (check-equal?
+    (parse-vector-length #'(vector 0 1))
+    2)
+  ;; --- make-vector
+  (check-equal?
+    (parse-vector-length #'(make-vector -1 1))
+    #f)
+  (check-equal?
+    (parse-vector-length #'(make-vector 0 8))
+    0)
+  (check-equal?
+    (parse-vector-length #'(make-vector 3 3))
+    3)
+  (check-equal?
+    (parse-vector-length #'(make-vector 99))
+    99)
+  ;; --- build-vector
+  (check-equal?
+    ;; Type error
+    (parse-vector-length #'(build-vector -1))
+    #f)
+  (check-equal?
+    (parse-vector-length #'(build-vector 0 (lambda (x) x)))
+    0)
+  (check-equal?
+    (parse-vector-length #'(build-vector 3 (lambda (x) 8)))
+    3)
+  (check-equal?
+    (parse-vector-length #'(build-vector 61 add1))
+    61)
+)

vector.rkt

@@ -0,0 +1,59 @@
+#lang typed/racket/base
+
+(provide
+  define-vector:
+  ;let-vector:
+  ;vector-length:
+  ;vector-ref:
+  ;vector-set!:
+  ;vector-map:
+  ;vector-append:
+
+  ;; TODO and a few more
+
+  ;; --- private
+  (for-syntax parse-vector-length)
+)
+
+;; -----------------------------------------------------------------------------
+
+(require
+  (for-syntax
+    typed/racket/base
+    syntax/id-table
+    syntax/parse
+    syntax/stx
+  ))
+
+;; =============================================================================
+
+(define-for-syntax vec-length-key 'vector:length)
+(define-for-syntax errloc-key 'vector:)
+(define-for-syntax id+vector-length (make-free-id-table))
+
+(define-syntax (define-vector: stx)
+  (syntax-parse stx
+   [(_ name:id v)
+    #:with len (parse-vector-length #'v)
+    #:when (syntax-e #'len)
+    (free-id-table-set! id+vector-length
+                        #'name
+                        (syntax-e #'len))
+    #'(define name v)]
+   [(_ e* ...)
+    #'(define e* ...)]))
+
+;; Assume `stx` is creating a vector; get the length of the vector to-be-made
+(define-for-syntax (parse-vector-length stx)
+  (syntax-parse stx #:literals (vector make-vector build-vector)
+   [(~or '#(e* ...)
+         #(e* ...)
+         ;; TODO #{} #[] #6{} ...
+         (vector e* ...))
+    (length (syntax->list #'(e* ...)))]
+   [(make-vector n:nat e* ...)
+    (syntax-e #'n)]
+   [(build-vector n:nat f)
+    (syntax-e #'n)]
+   [_ #f]))
+