[vector] add vector-ref

This commit is contained in:
ben 2016-03-01 10:49:35 -05:00
parent c0b53a0441
commit 1c033989e1
2 changed files with 78 additions and 18 deletions

View File

@ -56,4 +56,12 @@
(check-equal? (check-equal?
(parse-vector-length #'(build-vector 61 add1)) (parse-vector-length #'(build-vector 61 add1))
61) 61)
;; -- vector-length:
;; -- define-vector:
(let ()
(define-vector: v (vector 1 1 2 2))
(check-equal? (vector-ref: v 0) 1))
;; -- let-vector:
) )

View File

@ -1,13 +1,16 @@
#lang typed/racket/base #lang typed/racket/base
;; TODO integrate with trivial/math to get ints from identifiers
(provide (provide
define-vector: define-vector:
;let-vector: let-vector:
;vector-length: ;vector-length:
;vector-ref: vector-ref:
;vector-set!: ;vector-set!:
;vector-map: ;vector-map:
;vector-append: ;vector-append:
;vector->list
;; TODO and a few more ;; TODO and a few more
@ -18,6 +21,8 @@
;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
(require (require
(only-in racket/unsafe/ops
unsafe-vector-ref)
(for-syntax (for-syntax
typed/racket/base typed/racket/base
syntax/id-table syntax/id-table
@ -27,24 +32,70 @@
;; ============================================================================= ;; =============================================================================
(define-for-syntax vec-length-key 'vector:length) (define-for-syntax vector-length-key 'vector:length)
(define-for-syntax errloc-key 'vector:) (define-for-syntax errloc-key 'vector:)
(define-for-syntax id+vector-length (make-free-id-table)) (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* ...))
#:when (syntax-e #'len)
#:attr vector-length #'len)
))
(define-syntax (define-vector: stx) (define-syntax (define-vector: stx)
(syntax-parse stx (syntax-parse stx
[(_ name:id v) [(_ name:id v:literal-vector)
#:with len (parse-vector-length #'v)
#:when (syntax-e #'len)
(free-id-table-set! id+vector-length (free-id-table-set! id+vector-length
#'name #'name
(syntax-e #'len)) (syntax-e #'v.vector-length))
#'(define name v)] #'(define name v)]
[(_ e* ...) [(_ e* ...)
#'(define 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))])
e* ...))]
[(_ e* ...)
#'(let e* ...)]))
(define-for-syntax (vector-ref-error v i reason)
(raise-argument-error
errloc-key
(format "Index out-of-bounds: ~a" i)
v))
(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))
(vector-ref-error (syntax-e #'v) (syntax-e #'i)))
(syntax/loc stx (unsafe-vector-ref v i))]
[(_ e* ...)
(syntax/loc stx (vector-ref e* ...))]))
;; -----------------------------------------------------------------------------
;; Assume `stx` is creating a vector; get the length of the vector to-be-made ;; Assume `stx` is creating a vector; get the length of the vector to-be-made
(define-for-syntax (parse-vector-length stx) (define-for-syntax (parse-vector-length stx)
(cond
[(syntax-property stx vector-length-key)
=> (lambda (x) x)]
[(identifier? stx)
(free-id-table-ref id+vector-length stx #f)]
[else
(syntax-parse stx #:literals (vector make-vector build-vector) (syntax-parse stx #:literals (vector make-vector build-vector)
[(~or '#(e* ...) [(~or '#(e* ...)
#(e* ...) #(e* ...)
@ -55,5 +106,6 @@
(syntax-e #'n)] (syntax-e #'n)]
[(build-vector n:nat f) [(build-vector n:nat f)
(syntax-e #'n)] (syntax-e #'n)]
[_ #f])) [_ #f])]))