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

[vector] fill, ->list, ->immutable

Browse Source
This commit is contained in:
ben 2016-03-03 04:35:00 -05:00
parent 9c28e8b832
commit 0e2ab6563e
3 changed files with 200 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
test/vector-fail.rkt
View File

@ -34,6 +34,11 @@
(vector-map!: add1 (vector-map!: add1 (vector-map!: add1 (vector 0 0 0))))
3)
(let-vector: ([v (vector 0 0 0)]
[v2 (vector 1 2)])
(vector-ref: (vector-append: v2 v) 8))
(vector-ref: (vector->immutable-vector: (vector 1 2 1)) 3)
)))
;; -----------------------------------------------------------------------------

81
test/vector-pass.rkt
View File

@ -179,6 +179,87 @@
;)
;(test-suite "vector-map!:"
(test-case "vector/length map!"
(check-equal? (vector-map!: add1 (vector 1)) (vector 2)))
(test-case "vector/length map! via let"
(check-equal?
(let ()
(: v (Vectorof (Vectorof Integer)))
(define-vector: v (vector (vector 1) (vector 2 2) (vector 3 3 3) (vector 4 4 4 4)))
(vector-map!: (lambda ([x : (Vectorof Integer)]) (vector (vector-length: x))) v))
'#(#(1) #(2) #(3) #(4))))
(test-case "map!^3"
(check-equal?
(vector-map!: add1 (vector-map!: add1 (vector-map!: add1 (vector 0 0 0))))
(vector 3 3 3)))
(test-case "plain map!"
(check-equal?
((lambda ([v : (Vectorof (Vectorof Any))])
(vector-map!: (lambda ([x : (Vectorof Any)]) (vector (vector-ref: x 0))) v))
(vector (vector 1) (vector 2 2) (vector 3 3 3) (vector 4 4 4 4)))
'#(#(1) #(2) #(3) #(4))))
(test-case "large vector"
(let-vector: ([v* (ann (make-vector 200 #f) (Vectorof Boolean))])
(vector-map!: not v*)
(check-true (for/and ([v (in-vector v*)]) v))))
(test-case "higher-order map! pass"
(check-equal?
((lambda ([f : (-> (-> Symbol Symbol) (Vectorof Symbol) (Vectorof Symbol))])
(f (lambda (x) 'hi) (vector 'x 'yy 'z)))
vector-map!:)
(vector 'hi 'hi 'hi)))
(test-case "higher-order map! fail"
(check-exn exn:fail:contract?
(lambda ()
((lambda ([f : (-> (-> Integer Integer) (Vectorof Integer) (Vectorof Integer))])
(vector-ref: (f add1 (vector 0 0)) 3))
vector-map!:))))
;)
;(test-suite "vector-append:"
(test-case "append"
(let-vector: ([v (vector 0 0 8)]
[v2 (vector 1 2)])
(check-equal?
(vector-ref: (vector-append: v2 v) 4)
8)))
;)
;(test-suite "vector->list:"
(test-case "vector->list basic"
(let-vector: ([v (vector 8 8 8 1 8)])
(check-equal?
(vector->list: v)
'(8 8 8 1 8))))
(test-case "large vector->list"
(check-equal?
(vector->list: (ann (make-vector 300 '()) (Vectorof (Listof Any))))
(build-list 300 (lambda (i) '()))))
;)
;(test-suite "vector->immutable-vector"
(test-case "vector->immutable, basic"
(check-equal?
(vector-ref: (vector->immutable-vector: (vector 'a 'd 'e)) 0)
'a))
(test-case "vector->immutable"
(check-equal?
(vector-ref: (vector->immutable-vector: (vector 9 9 4)) 0)
9))
;)
;(test-suite "vector-fill!"
(test-case "vfill basic"
(let-vector: ([v (vector 2 3 1)])
(check-equal? (vector-fill!: v 9) (void))
(check-equal? (vector-ref v 2) 9)))
;)
;; -- define-vector:

142
vector.rkt
View File

@ -10,13 +10,16 @@
vector-set!:
vector-map:
vector-map!:
;vector-append:
;vector->list
;vector->immutable-vector
;vector-fill!
;
;; TODO and a few more
vector-append:
vector->list:
vector->immutable-vector:
vector-fill!:
;vector-take
;vector-take-right
;vector-drop
;vector-drop-right
;vector-split-at
;vector-split-at-right
;; --- private
(for-syntax parse-vector-length)
@ -116,18 +119,19 @@
[(_ f v:vector/length)
#:with (i* ...) (for/list ([i (in-range (syntax-e #'v.length))]) i)
#:with f+ (gensym 'f)
#:with v+ (syntax-property
(if (small-vector-size? (syntax-e #'v.length))
(syntax/loc stx
(let ([f+ f])
(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
(syntax-e #'v.length))
(syntax/loc stx v+)]
#:with v+ (gensym 'v)
#:with v++ (syntax-property
(if (small-vector-size? (syntax-e #'v.length))
(syntax/loc stx
(let ([f+ f] [v+ v.expanded])
(vector (f+ (unsafe-vector-ref v+ 'i*)) ...)))
(syntax/loc stx
(let ([f+ f] [v+ v.expanded])
(build-vector 'v.length (lambda ([i : Integer])
(f+ (vector-ref: v+ i)))))))
vector-length-key
(syntax-e #'v.length))
(syntax/loc stx v++)]
[_:id
(syntax/loc stx vector-map)]
[(_ e* ...)
@ -137,23 +141,105 @@
(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+)]
#:with v+ (gensym 'v)
#:with v++ (syntax-property
#'(let ([f+ f]
[v+ v.expanded])
(for ([i (in-range 'v.length)])
(unsafe-vector-set! v+ i (f+ (unsafe-vector-ref v+ i))))
v+)
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-syntax (vector-append: stx)
(syntax-parse stx
[(_ v1:vector/length v2:vector/length)
#:with v1+ (gensym 'v1)
#:with v2+ (gensym 'v2)
(define l1 (syntax-e #'v1.length))
(define l2 (syntax-e #'v2.length))
(syntax-property
(if (and (small-vector-size? l1)
(small-vector-size? l2))
(with-syntax ([(i1* ...) (for/list ([i (in-range l1)]) i)]
[(i2* ...) (for/list ([i (in-range l2)]) i)])
(syntax/loc stx
(let ([v1+ v1.expanded]
[v2+ v2.expanded])
(vector (vector-ref: v1+ i1*) ...
(vector-ref: v2+ i2*) ...))))
(quasisyntax/loc stx
(let ([v1+ v1.expanded]
[v2+ v2.expanded])
(build-vector
#,(+ l1 l2)
(lambda (i)
(if (< i '#,l1)
(unsafe-vector-ref v1+ i)
(unsafe-vector-ref v2+ i)))))))
vector-length-key
(+ l1 l2))]
[_:id
(syntax/loc stx vector-append)]
[(_ e* ...)
(syntax/loc stx (vector-append e* ...))]))
(define-syntax (vector->list: stx)
(syntax-parse stx
[(_ v:vector/length)
#:with v+ (gensym 'v)
(define len (syntax-e #'v.length))
(if (small-vector-size? len)
(with-syntax ([(i* ...) (for/list ([i (in-range len)]) i)])
(syntax/loc stx
(let ([v+ v.expanded])
(list (unsafe-vector-ref v+ i*) ...))))
(syntax/loc stx
(let ([v+ v.expanded])
(build-list 'v.length (lambda (i) (unsafe-vector-ref v+ i))))))]
[_:id
(syntax/loc stx vector->list)]
[(_ e* ...)
(syntax/loc stx (vector->list e* ...))]))
(define-syntax (vector->immutable-vector: stx)
(syntax-parse stx
[(_ v:vector/length)
(syntax-property
(syntax/loc stx (vector->immutable-vector v.expanded))
vector-length-key
(syntax-e #'v.length))]
[_:id
(syntax/loc stx vector->immutable-vector)]
[(_ e* ...)
(syntax/loc stx (vector->immutable-vector e* ...))]))
(define-syntax (vector-fill!: stx)
(syntax-parse stx
[(_ v:vector/length val)
#:with v+ (gensym 'v)
(define len (syntax-e #'v.length))
(syntax-property
(syntax/loc stx
(let ([v+ v.expanded])
(for ([i (in-range 'v.length)])
(unsafe-vector-set! v+ i val))))
vector-length-key
(syntax-e #'v.length))]
[_:id
(syntax/loc stx vector->fill!)]
[(_ e* ...)
(syntax/loc stx (vector->fill! e* ...))]))
;; -----------------------------------------------------------------------------
(define-for-syntax (small-vector-size? n)
(< n 101))
(< n 20))
;; Assume `stx` is creating a vector; get the length of the vector to-be-made
(define-for-syntax (parse-vector-length stx)