suzanne.soy/trivial
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[vector] vector-set

Browse Source
This commit is contained in:
ben 2016-03-02 13:21:00 -05:00
parent 1167e6a12b
commit 3dd29044de
3 changed files with 71 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
test/vector-fail.rkt
View File

@ -15,6 +15,12 @@
(define-vector: v (vector 3 4))
(vector-ref: v 9))
(let-vector: ([v1 (vector 1)])
(let-vector: ([v2 (vector v1)])
(vector-ref: (vector-ref: v2 0) 1)))
(vector-set!: (vector 0) 0 "hello") ;; Strong update
)))
;; -----------------------------------------------------------------------------

68
test/vector-pass.rkt
View File

@ -81,28 +81,60 @@
Zero)
0))
;; -- vector-ref
(test-case "vector/length ref"
(check-equal? (vector-ref: (vector 1) 0) 1))
;(test-suite "vector-ref:"
(test-case "vector/length ref"
(check-equal? (vector-ref: (vector 1) 0) 1))
(test-case "vector/length ref, via let"
(let-vector: ([v (vector 2)])
(check-equal? (vector-ref: v 0) 2)))
(test-case "vector/length ref, via let"
(let-vector: ([v (vector 2)])
(check-equal? (vector-ref: v 0) 2)))
(test-case "vector/length ref, via define"
(define-vector: v (vector "a" "bee" "sea"))
(check-equal? (vector-ref: v 2) "sea"))
(test-case "vector/length ref, via define"
(define-vector: v (vector "a" "bee" "sea"))
(check-equal? (vector-ref: v 2) "sea"))
(test-case "plain vector ref"
(check-equal?
((lambda (v) (vector-ref: v 3)) (vector 8 2 19 3 0))
3))
(test-case "plain vector ref"
(check-equal?
((lambda (v) (vector-ref: v 3)) (vector 8 2 19 3 0))
3))
(test-case "higher-order vector ref"
(check-exn exn:fail:contract?
(lambda ()
((lambda ([f : (-> (Vectorof Any) Natural Any)])
(f (vector 0 1 2) 10)) vector-ref:))))
(test-case "higher-order vector ref"
(check-exn exn:fail:contract?
(lambda ()
((lambda ([f : (-> (Vectorof Any) Natural Any)])
(f (vector 0 1 2) 10)) vector-ref:))))
(test-case "2-level ref"
(let-vector: ([v1 (vector 'X)])
(let-vector: ([v2 (vector v1)])
(check-equal? (vector-ref: (vector-ref: v2 0) 0) 'X))))
;)
;(test-suite "vector-set!:"
(test-case "vector/length set!"
(check-equal? (vector-set!: (vector 1) 0 8) (void)))
(test-case "vector/length set!, via let"
(let-vector: ([v (vector 2)])
(vector-set! v 0 3)
(check-equal? (vector-ref: v 0) 3)))
(test-case "vector/length set, via define"
(define-vector: v (vector "a" "bee" "sea"))
(vector-set! v 1 "bye")
(check-equal? (vector-ref: v 1) "bye"))
(test-case "plain vector set"
(check-equal?
((lambda (v) (vector-set!: v 3 4) (vector-ref: v 3)) (vector 8 2 19 3 0))
4))
(test-case "higher-order vector set"
(check-exn exn:fail:contract?
(lambda ()
((lambda ([f : (-> (Vectorof Any) Natural Any Void)])
(f (vector 0 1 2) 10 9)) vector-set!:))))
;)
;; -- define-vector:
(let ()

18
vector.rkt
View File

@ -7,7 +7,7 @@
let-vector:
vector-length:
vector-ref:
;vector-set!:
vector-set!:
;vector-map:
;vector-append:
;vector->list
@ -22,6 +22,7 @@
(require
(only-in racket/unsafe/ops
unsafe-vector-set!
unsafe-vector-ref)
(for-syntax
typed/racket/base
@ -67,7 +68,7 @@
[(_ e* ...)
#'(let e* ...)]))
(define-for-syntax (vector-ref-error v i)
(define-for-syntax (vector-bounds-error v i)
(raise-argument-error
errloc-key
(format "Index out-of-bounds: ~a" i)
@ -86,13 +87,24 @@
(syntax-parse stx
[(_ v:vector/length i:nat)
(unless (< (syntax-e #'i) (syntax-e #'v.length))
(vector-ref-error (syntax-e #'v) (syntax-e #'i)))
(vector-bounds-error (syntax-e #'v) (syntax-e #'i)))
(syntax/loc stx (unsafe-vector-ref v.expanded i))]
[_:id
(syntax/loc stx vector-ref)]
[(_ e* ...)
(syntax/loc stx (vector-ref e* ...))]))
(define-syntax (vector-set!: stx)
(syntax-parse stx
[(_ v:vector/length i:nat val)
(unless (< (syntax-e #'i) (syntax-e #'v.length))
(vector-bounds-error (syntax-e #'v) (syntax-e #'i)))
(syntax/loc stx (unsafe-vector-set! v.expanded i val))]
[_:id
(syntax/loc stx vector-set!)]
[(_ e* ...)
(syntax/loc stx (vector-set! e* ...))]))
;; -----------------------------------------------------------------------------
;; Assume `stx` is creating a vector; get the length of the vector to-be-made