From 0e2ab6563e95a459e19257bf2b5ba6bbd1d519f7 Mon Sep 17 00:00:00 2001 From: ben Date: Thu, 3 Mar 2016 04:35:00 -0500 Subject: [PATCH] [vector] fill, ->list, ->immutable --- test/vector-fail.rkt | 5 ++ test/vector-pass.rkt | 81 ++++++++++++++++++++++++ vector.rkt | 142 ++++++++++++++++++++++++++++++++++--------- 3 files changed, 200 insertions(+), 28 deletions(-) diff --git a/test/vector-fail.rkt b/test/vector-fail.rkt index e2be495..15d0053 100644 --- a/test/vector-fail.rkt +++ b/test/vector-fail.rkt @@ -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) ))) ;; ----------------------------------------------------------------------------- diff --git a/test/vector-pass.rkt b/test/vector-pass.rkt index 069a9be..0fb3105 100644 --- a/test/vector-pass.rkt +++ b/test/vector-pass.rkt @@ -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: diff --git a/vector.rkt b/vector.rkt index 9d5cdb3..fb939d2 100644 --- a/vector.rkt +++ b/vector.rkt @@ -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)