diff --git a/test/vector-pass.rkt b/test/vector-pass.rkt new file mode 100644 index 0000000..1dc6394 --- /dev/null +++ b/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) +) diff --git a/vector.rkt b/vector.rkt new file mode 100644 index 0000000..14f50ad --- /dev/null +++ b/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])) +