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

[vector] mutation map

Browse Source
This commit is contained in:
ben 2016-03-03 02:29:21 -05:00
parent 00619ff42d
commit 9c28e8b832
3 changed files with 38 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
test/vector-fail.rkt
View File

@ -27,6 +27,13 @@
(vector-map: add1 (vector-map: add1 (vector-map: add1 (vector 0 0 0)))) (vector-map: add1 (vector-map: add1 (vector-map: add1 (vector 0 0 0))))
3) 3)
(vector-ref: (vector-map!: (lambda (x) x) (vector #t #t)) 4)
(vector-ref: (vector-map!: symbol->string (vector 'a 'b)) 0)
(vector-ref:
(vector-map!: add1 (vector-map!: add1 (vector-map!: add1 (vector 0 0 0))))
3)
))) )))
;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
@ -40,6 +47,6 @@
(compile-syntax stx))) (compile-syntax stx)))
(for ([rkt (in-list TEST-CASE*)]) (for ([rkt (in-list TEST-CASE*)])
(check-exn #rx"vector::|Type Checker" (check-exn #rx"out-of-bounds|Type Checker"
(vector-eval rkt))) (vector-eval rkt)))
) )

4
test/vector-pass.rkt
View File

@ -159,6 +159,10 @@
(vector (vector 1) (vector 2 2) (vector 3 3 3) (vector 4 4 4 4))) (vector (vector 1) (vector 2 2) (vector 3 3 3) (vector 4 4 4 4)))
(vector 1 2 3 4))) (vector 1 2 3 4)))
(test-case "large vector"
(let-vector: ([v* (make-vector 200 #f)])
(check-true (for/and ([v (in-vector (vector-map: not v*))]) v))))
(test-case "higher-order map pass" (test-case "higher-order map pass"
(check-equal? (check-equal?
((lambda ([f : (-> (-> Symbol String) (Vectorof Symbol) (Vectorof String))]) ((lambda ([f : (-> (-> Symbol String) (Vectorof Symbol) (Vectorof String))])

29
vector.rkt
View File

@ -9,6 +9,7 @@
vector-ref: vector-ref:
vector-set!: vector-set!:
vector-map: vector-map:
vector-map!:
;vector-append: ;vector-append:
;vector->list ;vector->list
;vector->immutable-vector ;vector->immutable-vector
@ -114,11 +115,16 @@
(syntax-parse stx (syntax-parse stx
[(_ f v:vector/length) [(_ f v:vector/length)
#:with (i* ...) (for/list ([i (in-range (syntax-e #'v.length))]) i) #:with (i* ...) (for/list ([i (in-range (syntax-e #'v.length))]) i)
#:with f+ (gensym 'f)
#:with v+ (syntax-property #:with v+ (syntax-property
(if (small-vector-size? (syntax-e #'v.length)) (if (small-vector-size? (syntax-e #'v.length))
(syntax/loc stx (vector (f (unsafe-vector-ref v.expanded 'i*)) ...)) (syntax/loc stx
(syntax/loc stx (build-vector 'v.length (lambda ([i : Integer]) (let ([f+ f])
(unsafe-vector-ref v.expanded i))))) (vector (f+ (unsafe-vector-ref v.expanded 'i*)) ...)))
(syntax/loc stx
(let ([f+ f])
(build-vector 'v.length (lambda ([i : Integer])
(f+ (vector-ref: v.expanded i)))))))
vector-length-key vector-length-key
(syntax-e #'v.length)) (syntax-e #'v.length))
(syntax/loc stx v+)] (syntax/loc stx v+)]
@ -127,6 +133,23 @@
[(_ e* ...) [(_ e* ...)
(syntax/loc stx (vector-map e* ...))])) (syntax/loc stx (vector-map e* ...))]))
(define-syntax (vector-map!: stx)
(syntax-parse stx
[(_ f v:vector/length)
#:with f+ (gensym 'f)
#:with v+ (syntax-property
#'(let ([f+ f])
(for ([i (in-range 'v.length)])
(unsafe-vector-set! v.expanded i (f+ (unsafe-vector-ref v.expanded i))))
v.expanded)
vector-length-key
(syntax-e #'v.length))
(syntax/loc stx v+)]
[_:id
(syntax/loc stx vector-map!)]
[(_ e* ...)
(syntax/loc stx (vector-map! e* ...))]))
;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
(define-for-syntax (small-vector-size? n) (define-for-syntax (small-vector-size? n)