1303 lines
49 KiB
Scheme
1303 lines
49 KiB
Scheme
;;; 5_6.ms
|
|
;;; Copyright 1984-2017 Cisco Systems, Inc.
|
|
;;;
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|
;;; you may not use this file except in compliance with the License.
|
|
;;; You may obtain a copy of the License at
|
|
;;;
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
|
;;;
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
;;; See the License for the specific language governing permissions and
|
|
;;; limitations under the License.
|
|
|
|
(mat vector
|
|
(equal? (vector 1 2 3 4) '#(1 2 3 4))
|
|
(eq? (vector) '#())
|
|
)
|
|
|
|
(mat make-vector
|
|
(eqv? (vector-length (make-vector 10)) 10)
|
|
(eqv? (vector-length (make-vector 100)) 100)
|
|
(eqv? (vector-length (make-vector (+ 100 17))) 117)
|
|
(equal? (make-vector 0) '#())
|
|
(equal? (make-vector 3 'a) '#(a a a))
|
|
(equal? (make-vector 10 '#t) (vector #t #t #t #t #t #t #t #t #t #t))
|
|
(equal? (make-vector (- 4 2) (+ 1 1)) (vector 2 2))
|
|
(eqv? (make-vector (- 4 4) (+ 1 1)) (vector))
|
|
(error? (make-vector 'a 23))
|
|
)
|
|
|
|
(mat vector-length
|
|
(eqv? (vector-length '#(a b c)) 3)
|
|
(eqv? (vector-length '#100(a b c)) 100)
|
|
(eqv? (vector-length '#()) 0)
|
|
(error? (vector-length '(a b c)))
|
|
)
|
|
|
|
(mat $vector-ref-check?
|
|
(let ([v (make-vector 3)] [imm-v (vector->immutable-vector (make-vector 3))] [not-v (make-fxvector 3)])
|
|
(let ([i-1 -1] [i0 0] [i1 1] [i2 2] [i3 3] [ifalse #f] [ibig (+ (most-positive-fixnum) 1)])
|
|
(and
|
|
(not (#%$vector-ref-check? not-v i0))
|
|
(not (#%$vector-ref-check? v ifalse))
|
|
(not (#%$vector-ref-check? imm-v ifalse))
|
|
(not (#%$vector-ref-check? v i-1))
|
|
(not (#%$vector-ref-check? imm-v i-1))
|
|
(#%$vector-ref-check? v 0)
|
|
(#%$vector-ref-check? v 1)
|
|
(#%$vector-ref-check? v 2)
|
|
(#%$vector-ref-check? imm-v 0)
|
|
(#%$vector-ref-check? imm-v 1)
|
|
(#%$vector-ref-check? imm-v 2)
|
|
(#%$vector-ref-check? v i0)
|
|
(#%$vector-ref-check? v i1)
|
|
(#%$vector-ref-check? v i2)
|
|
(#%$vector-ref-check? imm-v i0)
|
|
(#%$vector-ref-check? imm-v i1)
|
|
(#%$vector-ref-check? imm-v i2)
|
|
(not (#%$vector-ref-check? v 3))
|
|
(not (#%$vector-ref-check? v i3))
|
|
(not (#%$vector-ref-check? v ibig))
|
|
(not (#%$vector-ref-check? imm-v 3))
|
|
(not (#%$vector-ref-check? imm-v i3))
|
|
(not (#%$vector-ref-check? imm-v ibig)))))
|
|
)
|
|
|
|
|
|
(mat vector-ref
|
|
(eqv? (vector-ref '#(a b c) 0) 'a)
|
|
(eqv? (vector-ref '#(a b c) 1) 'b)
|
|
(eqv? (vector-ref '#(a b c) 2) 'c)
|
|
(error? (vector-ref '#(a b c) 3))
|
|
(error? (vector-ref '#(a b c) -1))
|
|
(error? (vector-ref '#(a b c) 'a))
|
|
(error? (vector-ref '(a b c) 2))
|
|
)
|
|
|
|
(mat vector-set!
|
|
(let ((v (vector 'a 'b 'c)))
|
|
(and
|
|
(begin (vector-set! v 0 'x) (equal? v '#(x b c)))
|
|
(begin (vector-set! v 1 'y) (equal? v '#(x y c)))
|
|
(begin (vector-set! v 2 'z) (equal? v '#(x y z)))))
|
|
(error? (vector-set! (vector 'a 'b 'c) 3 'd))
|
|
(error? (vector-set! (vector 'a 'b 'c) -1 'd))
|
|
(error? (vector-set! (vector 'a 'b 'c) 'a 'd))
|
|
(error? (vector-set! (list 'a 'b 'c) 2 'd))
|
|
)
|
|
|
|
(mat vector-set-fixnum!
|
|
(let ((v (vector 'a 'b 'c)))
|
|
(and
|
|
(begin (vector-set-fixnum! v 0 5) (equal? v '#(5 b c)))
|
|
(begin (vector-set-fixnum! v 1 6) (equal? v '#(5 6 c)))
|
|
(begin (vector-set-fixnum! v 2 7) (equal? v '#(5 6 7)))))
|
|
(let ((v (vector 'a 'b 'c)) (n -1))
|
|
(and
|
|
(begin (set! n (+ n 1)) (vector-set-fixnum! v n (+ (* n n) 1)) (equal? v '#(1 b c)))
|
|
(begin (set! n (+ n 1)) (vector-set-fixnum! v n (+ (* n n) 1)) (equal? v '#(1 2 c)))
|
|
(begin (set! n (+ n 1)) (vector-set-fixnum! v n (+ (* n n) 1)) (equal? v '#(1 2 5)))))
|
|
(error? (vector-set-fixnum! (vector 'a 'b 'c) 3 0))
|
|
(error? (vector-set-fixnum! (vector 'a 'b 'c) -1 3))
|
|
(error? (vector-set-fixnum! (vector 'a 'b 'c) 'a 4))
|
|
(error? (vector-set-fixnum! (list 'a 'b 'c) 2 5))
|
|
(error? (vector-set-fixnum! (vector 'a 'b 'c) 2 'd))
|
|
(error? (vector-set-fixnum! (vector 'a 'b 'c) 2 #\d))
|
|
(error? (let ([v (vector 'a 'b 'c)] [n -1] [x '(a b c)])
|
|
(set! n (+ n 2))
|
|
(vector-set-fixnum! v n x)))
|
|
)
|
|
|
|
(mat vector-copy
|
|
(equal? (vector-copy '#()) '#())
|
|
(equal? (vector-copy '#(a b c)) '#(a b c))
|
|
(let* ((x1 (vector 1 2 3)) (x2 (vector-copy x1)))
|
|
(and (equal? x2 x1) (not (eq? x2 x1))))
|
|
(andmap
|
|
(lambda (n)
|
|
(let ([v (vector-map random (make-vector n 1000))])
|
|
(equal? (vector-copy v) v)))
|
|
(map random (make-list 500 2500)))
|
|
(error? (vector-copy '(a b c)))
|
|
)
|
|
|
|
(mat vector-fill!
|
|
(let ([v (vector-copy '#5(a b c d e))])
|
|
(and (equal? v '#5(a b c d e))
|
|
(begin
|
|
(vector-fill! v 9)
|
|
(equal? v '#5(9)))))
|
|
(let ([v (vector-copy '#5(a b c d e))])
|
|
(and (equal? v '#5(a b c d e))
|
|
(begin
|
|
(vector-fill! v (cons 'a 'b))
|
|
(equal? v '#5((a . b))))))
|
|
(error? (let ([v (fxvector)]) (vector-fill! v 3)))
|
|
(let ([v (make-vector 1000)])
|
|
(collect 0 1)
|
|
(let ([x (cons 'a 'b)])
|
|
(vector-fill! v x)
|
|
(collect 0 0)
|
|
(andmap (lambda (y) (eq? y x)) (vector->list v))))
|
|
)
|
|
|
|
(mat list->vector
|
|
(equal? (list->vector '(a b c)) '#(a b c))
|
|
(equal? (list->vector '()) '#())
|
|
(error? (list->vector '#(a b c)))
|
|
(error? (list->vector '(#\a #\b . #\c)))
|
|
(error? (list->vector (let ([ls (list #\a #\b #\c)]) (set-cdr! (cddr ls) (cdr ls)) ls)))
|
|
)
|
|
|
|
(mat vector->list
|
|
(equal? (vector->list '#(a b c)) '(a b c))
|
|
(equal? (vector->list '#()) '())
|
|
(error? (vector->list '(a b c)))
|
|
)
|
|
|
|
(mat fxvector
|
|
(equal? (fxvector 1 2 3 4) '#vfx(1 2 3 4))
|
|
(eq? (fxvector) '#vfx())
|
|
(fxvector? (fxvector (most-positive-fixnum)))
|
|
(fxvector? (fxvector (most-negative-fixnum)))
|
|
(error? (fxvector (+ (most-positive-fixnum) 1)))
|
|
(error? (fxvector (- (most-negative-fixnum) 1)))
|
|
(error? (fxvector 1 2 'a 4))
|
|
)
|
|
|
|
(mat make-fxvector
|
|
(eqv? (fxvector-length (make-fxvector 10)) 10)
|
|
(eqv? (fxvector-length (make-fxvector 100)) 100)
|
|
(eqv? (fxvector-length (make-fxvector (+ 100 17))) 117)
|
|
(eq? (make-fxvector 0) '#vfx())
|
|
(let ([x (make-fxvector 10)])
|
|
(and (= (fxvector-length x) 10)
|
|
(andmap fixnum? (fxvector->list x))))
|
|
(error? (make-fxvector 3 'a))
|
|
(error? (make-fxvector 10 (+ (most-positive-fixnum) 1)))
|
|
(error? (make-fxvector 10 (- (most-negative-fixnum) 1)))
|
|
(equal? (make-fxvector 10 7) (fxvector 7 7 7 7 7 7 7 7 7 7))
|
|
(equal? (make-fxvector (- 4 2) (+ 1 1)) (fxvector 2 2))
|
|
(eqv? (make-fxvector (- 4 4) (+ 1 1)) (fxvector))
|
|
)
|
|
|
|
(mat fxvector-syntax
|
|
(eq? '#vfx() '#vfx())
|
|
(eq? '#0vfx() #vfx())
|
|
(equal?
|
|
'(#vfx(1 2 3) #3vfx(1 2 3) #6vfx(1 2 3))
|
|
(list (fxvector 1 2 3) (fxvector 1 2 3) (fxvector 1 2 3 3 3 3)))
|
|
(let ([x #10vfx()])
|
|
(and (= (fxvector-length x) 10)
|
|
(andmap fixnum? (fxvector->list x))))
|
|
; the following is invalid because the reader doesn't allow graph marks
|
|
; and references within an fxvector
|
|
; (equal? '(#0=#vfx(#1=33 #2# #1# #2=44 #3#) #2# #3=55)
|
|
; '(#vfx(33 44 33 44 55) 44 55))
|
|
)
|
|
|
|
(mat fxvector-length
|
|
(eqv? (fxvector-length '#vfx(3 4 5)) 3)
|
|
(eqv? (fxvector-length '#100vfx(5 4 3)) 100)
|
|
(eqv? (fxvector-length '#vfx()) 0)
|
|
(error? (fxvector-length '(a b c)))
|
|
)
|
|
|
|
(mat $fxvector-ref-check?
|
|
(let ([fv (make-fxvector 3)] [imm-fv (fxvector->immutable-fxvector (make-fxvector 3))] [not-fv (make-vector 3)])
|
|
(let ([i-1 -1] [i0 0] [i1 1] [i2 2] [i3 3] [ifalse #f] [ibig (+ (most-positive-fixnum) 1)])
|
|
(and
|
|
(not (#%$fxvector-ref-check? not-fv i0))
|
|
(not (#%$fxvector-ref-check? fv ifalse))
|
|
(not (#%$fxvector-ref-check? fv i-1))
|
|
(not (#%$fxvector-ref-check? imm-fv i-1))
|
|
(#%$fxvector-ref-check? fv 0)
|
|
(#%$fxvector-ref-check? fv 1)
|
|
(#%$fxvector-ref-check? fv 2)
|
|
(#%$fxvector-ref-check? imm-fv 0)
|
|
(#%$fxvector-ref-check? imm-fv 1)
|
|
(#%$fxvector-ref-check? imm-fv 2)
|
|
(#%$fxvector-ref-check? fv i0)
|
|
(#%$fxvector-ref-check? fv i1)
|
|
(#%$fxvector-ref-check? fv i2)
|
|
(#%$fxvector-ref-check? imm-fv i0)
|
|
(#%$fxvector-ref-check? imm-fv i1)
|
|
(#%$fxvector-ref-check? imm-fv i2)
|
|
(not (#%$fxvector-ref-check? fv 3))
|
|
(not (#%$fxvector-ref-check? fv i3))
|
|
(not (#%$fxvector-ref-check? fv ibig))
|
|
(not (#%$fxvector-ref-check? imm-fv 3))
|
|
(not (#%$fxvector-ref-check? imm-fv i3))
|
|
(not (#%$fxvector-ref-check? imm-fv ibig)))))
|
|
)
|
|
|
|
(mat fxvector-ref
|
|
(eqv? (fxvector-ref '#vfx(3 4 5) 0) '3)
|
|
(eqv? (fxvector-ref '#vfx(3 4 5) 1) '4)
|
|
(eqv? (fxvector-ref '#vfx(3 4 5) 2) '5)
|
|
(eqv? (fxvector-ref (fxvector (most-positive-fixnum)) 0) (most-positive-fixnum))
|
|
(eqv? (fxvector-ref (fxvector (most-negative-fixnum)) 0) (most-negative-fixnum))
|
|
(error? (fxvector-ref '#vfx(3 4 5) 3))
|
|
(error? (fxvector-ref '#vfx(3 4 5) -1))
|
|
(error? (fxvector-ref '#vfx(3 4 5) 'a))
|
|
(error? (fxvector-ref '#(3 4 5) 2))
|
|
(error? (fxvector-ref '(3 4 5) 2))
|
|
)
|
|
|
|
(mat fxvector-set!
|
|
(let ((v (fxvector '3 '4 '5)))
|
|
(and
|
|
(begin (fxvector-set! v 0 '33) (equal? v '#vfx(33 4 5)))
|
|
(begin (fxvector-set! v 1 '44) (equal? v '#vfx(33 44 5)))
|
|
(begin (fxvector-set! v 2 '55) (equal? v '#vfx(33 44 55)))))
|
|
(error? (fxvector-set! (fxvector '3 '4 '5) 3 'd))
|
|
(error? (fxvector-set! (fxvector '3 '4 '5) -1 'd))
|
|
(error? (fxvector-set! (fxvector '3 '4 '5) 'a 'd))
|
|
(error? (fxvector-set! (fxvector '3 '4 '5) 2 'd))
|
|
(error? (fxvector-set! (list '3 '4 '5) 2 'd))
|
|
(error? (fxvector-set! (fxvector 3 4 5) 1 (- (most-negative-fixnum) 1)))
|
|
(error? (fxvector-set! (fxvector 3 4 5) 0 (+ (most-positive-fixnum) 1)))
|
|
(begin
|
|
(define test-fxvector-set!
|
|
(lambda (v i x)
|
|
(fxvector-set! v i x)))
|
|
#t)
|
|
(equal?
|
|
(let ([v (fxvector 3 4 5)])
|
|
(test-fxvector-set! v 0 -3)
|
|
(test-fxvector-set! v 1 -4)
|
|
(test-fxvector-set! v 2 17)
|
|
v)
|
|
#vfx(-3 -4 17))
|
|
(error? (test-fxvector-set! (list 3 4 5) 0 9))
|
|
(error? (test-fxvector-set! (vector 3 4) 0 9))
|
|
(error? (test-fxvector-set! (fxvector 3 4 5) 3 9))
|
|
(error? (test-fxvector-set! (fxvector 3 4 5) -3 9))
|
|
(error? (test-fxvector-set! (fxvector 3 4 5) (+ (most-positive-fixnum) 1) 9))
|
|
(error? (test-fxvector-set! (fxvector 3 4 5) (- (most-negative-fixnum) 1) 9))
|
|
(error? (test-fxvector-set! (fxvector 3 4 5) 'a 9))
|
|
(error? (test-fxvector-set! (fxvector 3 4 5) 2 (+ (most-positive-fixnum) 1)))
|
|
(error? (test-fxvector-set! (fxvector 3 4 5) 2 (- (most-negative-fixnum) 1)))
|
|
(error? (test-fxvector-set! (fxvector 3 4 5) 2 'a))
|
|
)
|
|
|
|
(mat fxvector-copy
|
|
(equal? (fxvector-copy '#vfx()) '#vfx())
|
|
(equal? (fxvector-copy '#vfx(3 4 5)) '#vfx(3 4 5))
|
|
(let* ((x1 (fxvector 1 2 3)) (x2 (fxvector-copy x1)))
|
|
(and (equal? x2 x1) (not (eq? x2 x1))))
|
|
(andmap
|
|
(lambda (n)
|
|
(let ([v (list->fxvector (map random (make-list n 1000)))])
|
|
(equal? (fxvector-copy v) v)))
|
|
(map random (make-list 500 2500)))
|
|
(error? (fxvector-copy '(a b c)))
|
|
)
|
|
|
|
(mat fxvector-fill!
|
|
(let ([v (fxvector-copy '#5vfx(1 2 3 4 5))])
|
|
(and (equal? v '#5vfx(1 2 3 4 5))
|
|
(begin
|
|
(fxvector-fill! v 9)
|
|
(equal? v '#5vfx(9)))))
|
|
(let ([v (fxvector-copy '#5vfx(1 2 3 4 5))])
|
|
(and (equal? v '#5vfx(1 2 3 4 5))
|
|
(begin
|
|
(fxvector-fill! v -17)
|
|
(equal? v '#5vfx(-17)))))
|
|
(error? (let ([v (fxvector 1)]) (fxvector-fill! v 'a)))
|
|
(error? (let ([v (vector 1)]) (fxvector-fill! v 3)))
|
|
)
|
|
|
|
(mat list->fxvector
|
|
(equal? (list->fxvector '(1 2 3)) '#vfx(1 2 3))
|
|
(equal? (list->fxvector '()) '#vfx())
|
|
(error? (list->fxvector '#(a b c)))
|
|
(error? (list->fxvector '(1 2 . 3)))
|
|
(error? (list->fxvector (let ([ls (list 1 2 3)]) (set-cdr! (cddr ls) (cdr ls)) ls)))
|
|
)
|
|
|
|
(mat fxvector->list
|
|
(equal? (fxvector->list '#vfx(1 2 3)) '(1 2 3))
|
|
(equal? (fxvector->list '#vfx()) '())
|
|
(error? (fxvector->list '(a b c)))
|
|
)
|
|
|
|
(mat vector-map
|
|
(error? ; invalid number of arguments
|
|
(vector-map))
|
|
(error? ; invalid number of arguments
|
|
(vector-map '#()))
|
|
(error? ; invalid number of arguments
|
|
(vector-map +))
|
|
(error? ; non procedure '#()
|
|
(vector-map '#() '#()))
|
|
(error? ; non procedure '#()
|
|
(vector-map '#() '#() '#()))
|
|
(error? ; non procedure '#()
|
|
(vector-map '#() '#() '#() '()))
|
|
(error? ; non procedure '#()
|
|
(vector-map '#() '#() '#() '#() '#()))
|
|
(error? ; non vector 3
|
|
(vector-map + 3))
|
|
(error? ; non vector (3)
|
|
(vector-map + '#() '(3)))
|
|
(error? ; non vector (3)
|
|
(vector-map + '#() '#() '(3)))
|
|
(error? ; non vector (3)
|
|
(vector-map + '#() '#() '(3) '#()))
|
|
(error? ; non vector 7
|
|
(vector-map + 7 '#() '#() '#() '#()))
|
|
(error? ; lengths differ
|
|
(vector-map + '#() '#(x)))
|
|
(error? ; lengths differ
|
|
(vector-map + '#() '#() '#(x)))
|
|
(error? ; lengths differ
|
|
(vector-map + '#() '#() '#(x) '#()))
|
|
(error? ; lengths differ
|
|
(vector-map + '#(y) '#() '#(x) '#()))
|
|
(error? ; lengths differ
|
|
(vector-map + '#(y) '#() '#() '#() '#()))
|
|
|
|
(equal? (vector-map + '#()) '#())
|
|
(equal? (vector-map + '#(1)) '#(1))
|
|
(equal? (vector-map + '#(1 2)) '#(1 2))
|
|
(equal? (vector-map + '#(1 2 3)) '#(1 2 3))
|
|
(equal? (vector-map + '#(1 2 3 4)) '#(1 2 3 4))
|
|
(equal? (vector-map + (make-vector 100 7)) '#100(7))
|
|
|
|
(equal? (vector-map list '#() '#()) '#())
|
|
(equal? (vector-map list '#(1) '#(5)) '#((1 5)))
|
|
(equal? (vector-map list '#(1 2) '#(5 7)) '#((1 5) (2 7)))
|
|
(equal? (vector-map list '#(1 2 3) '#(a b c)) '#((1 a) (2 b) (3 c)))
|
|
(equal? (vector-map list '#(1 2 3 4) '#(a b c d)) '#((1 a) (2 b) (3 c) (4 d)))
|
|
|
|
(equal? (vector-map list '#() '#() '#()) '#())
|
|
(equal? (vector-map list '#(1) '#(5) '#(a)) '#((1 5 a)))
|
|
(equal? (vector-map list '#(1 2) '#(5 7) '#(a b)) '#((1 5 a) (2 7 b)))
|
|
(equal?
|
|
(vector-map list '#(1 2 3) '#(5 7 9) '#(a b c))
|
|
'#((1 5 a) (2 7 b) (3 9 c)))
|
|
(equal?
|
|
(vector-map list '#(1 2 3 4) '#(5 7 9 11) '#(a b c d))
|
|
'#((1 5 a) (2 7 b) (3 9 c) (4 11 d)))
|
|
|
|
(equal? (vector-map list '#() '#() '#() '#()) '#())
|
|
(equal? (vector-map list '#(#\a) '#(1) '#(5) '#(a)) '#((#\a 1 5 a)))
|
|
(equal?
|
|
(vector-map list '#(#\a #\b) '#(1 2) '#(5 7) '#(a b))
|
|
'#((#\a 1 5 a) (#\b 2 7 b)))
|
|
(equal?
|
|
(vector-map list '#(#\a #\b #\c) '#(1 2 3) '#(5 7 9) '#(a b c))
|
|
'#((#\a 1 5 a) (#\b 2 7 b) (#\c 3 9 c)))
|
|
(equal?
|
|
(vector-map list '#(#\a #\b #\c #\d) '#(1 2 3 4) '#(5 7 9 11) '#(a b c d))
|
|
'#((#\a 1 5 a) (#\b 2 7 b) (#\c 3 9 c) (#\d 4 11 d)))
|
|
(let ([orig-v #f] [orig-elts #f] [next #f])
|
|
(let ([n 100])
|
|
(let ([v (vector-map
|
|
(lambda (x) (cons (call/cc values) x))
|
|
(list->vector (iota n)))])
|
|
(if orig-v
|
|
(unless (andmap eq? (vector->list orig-v) orig-elts)
|
|
(errorf #f "original vector-map elts mutated"))
|
|
(begin
|
|
(set! orig-v v)
|
|
(set! orig-elts (vector->list v))
|
|
(set! next 0)))
|
|
(let ([m next])
|
|
(unless (= m n)
|
|
(set! next (fx+ next 1))
|
|
(let ([p (vector-ref orig-v m)])
|
|
(unless (eqv? (cdr p) m)
|
|
(errorf #f "unexpected cdr value (~s instead of ~s)" (cdr p) m))
|
|
((car p) n)))))
|
|
(eqv? next n)))
|
|
(begin
|
|
(define ($vector-map-f1 p x1 x2 x3 x4 x5)
|
|
(vector
|
|
(vector-map p '#())
|
|
(vector-map p '#() x1)
|
|
(vector-map p '#() x1 x2)
|
|
(vector-map p '#() x1 x2 x3)
|
|
(vector-map p '#() x1 x2 x3 x4)
|
|
(vector-map p '#() x1 x2 x3 x4 x5)
|
|
(vector-map p x1 '#())
|
|
(vector-map p x1 '#() x2)
|
|
(vector-map p x1 '#() x2 x3)
|
|
(vector-map p x1 '#() x2 x3 x4)
|
|
(vector-map p x1 '#() x2 x3 x4 x5)
|
|
(vector-map p x1 x2 '#())
|
|
(vector-map p x1 x2 '#() x3)
|
|
(vector-map p x1 x2 '#() x3 x4)
|
|
(vector-map p x1 x2 '#() x3 x4 x5)
|
|
(vector-map p x1 x2 x3 '#())
|
|
(vector-map p x1 x2 x3 '#() x4)
|
|
(vector-map p x1 x2 x3 '#() x4 x5)
|
|
(vector-map p x1 x2 x3 x4 '#())
|
|
(vector-map p x1 x2 x3 x4 '#() x5)
|
|
(vector-map p x1 x2 x3 x4 x5 '#())))
|
|
(procedure? $vector-map-f1))
|
|
(equal?
|
|
($vector-map-f1 vector '#() '#() '#() '#() '#())
|
|
'#(#() #() #() #() #() #() #() #() #() #() #() #() #() #() #() #() #() #()
|
|
#() #() #()))
|
|
(begin
|
|
(define ($vector-map-f1 p x1 x2 x3 x4 x5)
|
|
(vector
|
|
(vector-map p '#(a))
|
|
(vector-map p '#(a) x1)
|
|
(vector-map p '#(a) x1 x2)
|
|
(vector-map p '#(a) x1 x2 x3)
|
|
(vector-map p '#(a) x1 x2 x3 x4)
|
|
(vector-map p '#(a) x1 x2 x3 x4 x5)
|
|
(vector-map p x1 '#(a))
|
|
(vector-map p x1 '#(a) x2)
|
|
(vector-map p x1 '#(a) x2 x3)
|
|
(vector-map p x1 '#(a) x2 x3 x4)
|
|
(vector-map p x1 '#(a) x2 x3 x4 x5)
|
|
(vector-map p x1 x2 '#(a))
|
|
(vector-map p x1 x2 '#(a) x3)
|
|
(vector-map p x1 x2 '#(a) x3 x4)
|
|
(vector-map p x1 x2 '#(a) x3 x4 x5)
|
|
(vector-map p x1 x2 x3 '#(a))
|
|
(vector-map p x1 x2 x3 '#(a) x4)
|
|
(vector-map p x1 x2 x3 '#(a) x4 x5)
|
|
(vector-map p x1 x2 x3 x4 '#(a))
|
|
(vector-map p x1 x2 x3 x4 '#(a) x5)
|
|
(vector-map p x1 x2 x3 x4 x5 '#(a))))
|
|
(procedure? $vector-map-f1))
|
|
(equal?
|
|
($vector-map-f1 vector '#(1) '#(4) '#(d) '#(g) '#(7))
|
|
'#(#(#(a))
|
|
#(#(a 1))
|
|
#(#(a 1 4))
|
|
#(#(a 1 4 d))
|
|
#(#(a 1 4 d g))
|
|
#(#(a 1 4 d g 7))
|
|
#(#(1 a))
|
|
#(#(1 a 4))
|
|
#(#(1 a 4 d))
|
|
#(#(1 a 4 d g))
|
|
#(#(1 a 4 d g 7))
|
|
#(#(1 4 a))
|
|
#(#(1 4 a d))
|
|
#(#(1 4 a d g))
|
|
#(#(1 4 a d g 7))
|
|
#(#(1 4 d a))
|
|
#(#(1 4 d a g))
|
|
#(#(1 4 d a g 7))
|
|
#(#(1 4 d g a))
|
|
#(#(1 4 d g a 7))
|
|
#(#(1 4 d g 7 a))))
|
|
(begin
|
|
(define ($vector-map-f1 p x1 x2 x3 x4 x5)
|
|
(vector
|
|
(vector-map p '#(a b))
|
|
(vector-map p '#(a b) x1)
|
|
(vector-map p '#(a b) x1 x2)
|
|
(vector-map p '#(a b) x1 x2 x3)
|
|
(vector-map p '#(a b) x1 x2 x3 x4)
|
|
(vector-map p '#(a b) x1 x2 x3 x4 x5)
|
|
(vector-map p x1 '#(a b))
|
|
(vector-map p x1 '#(a b) x2)
|
|
(vector-map p x1 '#(a b) x2 x3)
|
|
(vector-map p x1 '#(a b) x2 x3 x4)
|
|
(vector-map p x1 '#(a b) x2 x3 x4 x5)
|
|
(vector-map p x1 x2 '#(a b))
|
|
(vector-map p x1 x2 '#(a b) x3)
|
|
(vector-map p x1 x2 '#(a b) x3 x4)
|
|
(vector-map p x1 x2 '#(a b) x3 x4 x5)
|
|
(vector-map p x1 x2 x3 '#(a b))
|
|
(vector-map p x1 x2 x3 '#(a b) x4)
|
|
(vector-map p x1 x2 x3 '#(a b) x4 x5)
|
|
(vector-map p x1 x2 x3 x4 '#(a b))
|
|
(vector-map p x1 x2 x3 x4 '#(a b) x5)
|
|
(vector-map p x1 x2 x3 x4 x5 '#(a b))))
|
|
(procedure? $vector-map-f1))
|
|
(equal?
|
|
($vector-map-f1 vector '#(1 2) '#(4 5) '#(d e) '#(g h) '#(7 j))
|
|
'#(#(#(a) #(b))
|
|
#(#(a 1) #(b 2))
|
|
#(#(a 1 4) #(b 2 5))
|
|
#(#(a 1 4 d) #(b 2 5 e))
|
|
#(#(a 1 4 d g) #(b 2 5 e h))
|
|
#(#(a 1 4 d g 7) #(b 2 5 e h j))
|
|
#(#(1 a) #(2 b))
|
|
#(#(1 a 4) #(2 b 5))
|
|
#(#(1 a 4 d) #(2 b 5 e))
|
|
#(#(1 a 4 d g) #(2 b 5 e h))
|
|
#(#(1 a 4 d g 7) #(2 b 5 e h j))
|
|
#(#(1 4 a) #(2 5 b))
|
|
#(#(1 4 a d) #(2 5 b e))
|
|
#(#(1 4 a d g) #(2 5 b e h))
|
|
#(#(1 4 a d g 7) #(2 5 b e h j))
|
|
#(#(1 4 d a) #(2 5 e b))
|
|
#(#(1 4 d a g) #(2 5 e b h))
|
|
#(#(1 4 d a g 7) #(2 5 e b h j))
|
|
#(#(1 4 d g a) #(2 5 e h b))
|
|
#(#(1 4 d g a 7) #(2 5 e h b j))
|
|
#(#(1 4 d g 7 a) #(2 5 e h j b))))
|
|
(begin
|
|
(define ($vector-map-f1 p x1 x2 x3 x4 x5)
|
|
(vector
|
|
(vector-map p '#(a b c))
|
|
(vector-map p '#(a b c) x1)
|
|
(vector-map p '#(a b c) x1 x2)
|
|
(vector-map p '#(a b c) x1 x2 x3)
|
|
(vector-map p '#(a b c) x1 x2 x3 x4)
|
|
(vector-map p '#(a b c) x1 x2 x3 x4 x5)
|
|
(vector-map p x1 '#(a b c))
|
|
(vector-map p x1 '#(a b c) x2)
|
|
(vector-map p x1 '#(a b c) x2 x3)
|
|
(vector-map p x1 '#(a b c) x2 x3 x4)
|
|
(vector-map p x1 '#(a b c) x2 x3 x4 x5)
|
|
(vector-map p x1 x2 '#(a b c))
|
|
(vector-map p x1 x2 '#(a b c) x3)
|
|
(vector-map p x1 x2 '#(a b c) x3 x4)
|
|
(vector-map p x1 x2 '#(a b c) x3 x4 x5)
|
|
(vector-map p x1 x2 x3 '#(a b c))
|
|
(vector-map p x1 x2 x3 '#(a b c) x4)
|
|
(vector-map p x1 x2 x3 '#(a b c) x4 x5)
|
|
(vector-map p x1 x2 x3 x4 '#(a b c))
|
|
(vector-map p x1 x2 x3 x4 '#(a b c) x5)
|
|
(vector-map p x1 x2 x3 x4 x5 '#(a b c))))
|
|
(procedure? $vector-map-f1))
|
|
(equal?
|
|
($vector-map-f1 vector '#(1 2 3) '#(4 5 6) '#(d e f) '#(g h i) '#(7 j 9))
|
|
'#(#(#(a) #(b) #(c))
|
|
#(#(a 1) #(b 2) #(c 3))
|
|
#(#(a 1 4) #(b 2 5) #(c 3 6))
|
|
#(#(a 1 4 d) #(b 2 5 e) #(c 3 6 f))
|
|
#(#(a 1 4 d g) #(b 2 5 e h) #(c 3 6 f i))
|
|
#(#(a 1 4 d g 7) #(b 2 5 e h j) #(c 3 6 f i 9))
|
|
#(#(1 a) #(2 b) #(3 c))
|
|
#(#(1 a 4) #(2 b 5) #(3 c 6))
|
|
#(#(1 a 4 d) #(2 b 5 e) #(3 c 6 f))
|
|
#(#(1 a 4 d g) #(2 b 5 e h) #(3 c 6 f i))
|
|
#(#(1 a 4 d g 7) #(2 b 5 e h j) #(3 c 6 f i 9))
|
|
#(#(1 4 a) #(2 5 b) #(3 6 c))
|
|
#(#(1 4 a d) #(2 5 b e) #(3 6 c f))
|
|
#(#(1 4 a d g) #(2 5 b e h) #(3 6 c f i))
|
|
#(#(1 4 a d g 7) #(2 5 b e h j) #(3 6 c f i 9))
|
|
#(#(1 4 d a) #(2 5 e b) #(3 6 f c))
|
|
#(#(1 4 d a g) #(2 5 e b h) #(3 6 f c i))
|
|
#(#(1 4 d a g 7) #(2 5 e b h j) #(3 6 f c i 9))
|
|
#(#(1 4 d g a) #(2 5 e h b) #(3 6 f i c))
|
|
#(#(1 4 d g a 7) #(2 5 e h b j) #(3 6 f i c 9))
|
|
#(#(1 4 d g 7 a) #(2 5 e h j b) #(3 6 f i 9 c))))
|
|
(begin
|
|
(define ($vector-map-f1 p x1 x2 x3 x4 x5)
|
|
(vector
|
|
(vector-map p '#(a b c d))
|
|
(vector-map p '#(a b c d) x1)
|
|
(vector-map p '#(a b c d) x1 x2)
|
|
(vector-map p '#(a b c d) x1 x2 x3)
|
|
(vector-map p '#(a b c d) x1 x2 x3 x4)
|
|
(vector-map p '#(a b c d) x1 x2 x3 x4 x5)
|
|
(vector-map p x1 '#(a b c d))
|
|
(vector-map p x1 '#(a b c d) x2)
|
|
(vector-map p x1 '#(a b c d) x2 x3)
|
|
(vector-map p x1 '#(a b c d) x2 x3 x4)
|
|
(vector-map p x1 '#(a b c d) x2 x3 x4 x5)
|
|
(vector-map p x1 x2 '#(a b c d))
|
|
(vector-map p x1 x2 '#(a b c d) x3)
|
|
(vector-map p x1 x2 '#(a b c d) x3 x4)
|
|
(vector-map p x1 x2 '#(a b c d) x3 x4 x5)
|
|
(vector-map p x1 x2 x3 '#(a b c d))
|
|
(vector-map p x1 x2 x3 '#(a b c d) x4)
|
|
(vector-map p x1 x2 x3 '#(a b c d) x4 x5)
|
|
(vector-map p x1 x2 x3 x4 '#(a b c d))
|
|
(vector-map p x1 x2 x3 x4 '#(a b c d) x5)
|
|
(vector-map p x1 x2 x3 x4 x5 '#(a b c d))))
|
|
(procedure? $vector-map-f1))
|
|
(equal?
|
|
($vector-map-f1 vector '#(1 2 3 4) '#(f g h i) '#(k l m n) '#(p q r s) '#(u v w x))
|
|
'#(#(#(a) #(b) #(c) #(d)) #(#(a 1) #(b 2) #(c 3) #(d 4))
|
|
#(#(a 1 f) #(b 2 g) #(c 3 h) #(d 4 i))
|
|
#(#(a 1 f k) #(b 2 g l) #(c 3 h m) #(d 4 i n))
|
|
#(#(a 1 f k p) #(b 2 g l q) #(c 3 h m r) #(d 4 i n s))
|
|
#(#(a 1 f k p u) #(b 2 g l q v) #(c 3 h m r w) #(d 4 i n s x))
|
|
#(#(1 a) #(2 b) #(3 c) #(4 d))
|
|
#(#(1 a f) #(2 b g) #(3 c h) #(4 d i))
|
|
#(#(1 a f k) #(2 b g l) #(3 c h m) #(4 d i n))
|
|
#(#(1 a f k p) #(2 b g l q) #(3 c h m r) #(4 d i n s))
|
|
#(#(1 a f k p u) #(2 b g l q v) #(3 c h m r w) #(4 d i n s x))
|
|
#(#(1 f a) #(2 g b) #(3 h c) #(4 i d))
|
|
#(#(1 f a k) #(2 g b l) #(3 h c m) #(4 i d n))
|
|
#(#(1 f a k p) #(2 g b l q) #(3 h c m r) #(4 i d n s))
|
|
#(#(1 f a k p u) #(2 g b l q v) #(3 h c m r w) #(4 i d n s x))
|
|
#(#(1 f k a) #(2 g l b) #(3 h m c) #(4 i n d))
|
|
#(#(1 f k a p) #(2 g l b q) #(3 h m c r) #(4 i n d s))
|
|
#(#(1 f k a p u) #(2 g l b q v) #(3 h m c r w) #(4 i n d s x))
|
|
#(#(1 f k p a) #(2 g l q b) #(3 h m r c) #(4 i n s d))
|
|
#(#(1 f k p a u) #(2 g l q b v) #(3 h m r c w) #(4 i n s d x))
|
|
#(#(1 f k p u a) #(2 g l q v b) #(3 h m r w c) #(4 i n s x d))))
|
|
(begin
|
|
(define ($vector-map-f1 p x1 x2 x3 x4 x5)
|
|
(vector
|
|
(vector-map p '#(a b c d e))
|
|
(vector-map p '#(a b c d e) x1)
|
|
(vector-map p '#(a b c d e) x1 x2)
|
|
(vector-map p '#(a b c d e) x1 x2 x3)
|
|
(vector-map p '#(a b c d e) x1 x2 x3 x4)
|
|
(vector-map p '#(a b c d e) x1 x2 x3 x4 x5)
|
|
(vector-map p x1 '#(a b c d e))
|
|
(vector-map p x1 '#(a b c d e) x2)
|
|
(vector-map p x1 '#(a b c d e) x2 x3)
|
|
(vector-map p x1 '#(a b c d e) x2 x3 x4)
|
|
(vector-map p x1 '#(a b c d e) x2 x3 x4 x5)
|
|
(vector-map p x1 x2 '#(a b c d e))
|
|
(vector-map p x1 x2 '#(a b c d e) x3)
|
|
(vector-map p x1 x2 '#(a b c d e) x3 x4)
|
|
(vector-map p x1 x2 '#(a b c d e) x3 x4 x5)
|
|
(vector-map p x1 x2 x3 '#(a b c d e))
|
|
(vector-map p x1 x2 x3 '#(a b c d e) x4)
|
|
(vector-map p x1 x2 x3 '#(a b c d e) x4 x5)
|
|
(vector-map p x1 x2 x3 x4 '#(a b c d e))
|
|
(vector-map p x1 x2 x3 x4 '#(a b c d e) x5)
|
|
(vector-map p x1 x2 x3 x4 x5 '#(a b c d e))))
|
|
(procedure? $vector-map-f1))
|
|
(equal?
|
|
($vector-map-f1 vector '#(1 2 3 4 5) '#(f g h i j) '#(k l m n o) '#(p q r s t) '#(u v w x y))
|
|
'#(#(#(a) #(b) #(c) #(d) #(e)) #(#(a 1) #(b 2) #(c 3) #(d 4) #(e 5))
|
|
#(#(a 1 f) #(b 2 g) #(c 3 h) #(d 4 i) #(e 5 j))
|
|
#(#(a 1 f k) #(b 2 g l) #(c 3 h m) #(d 4 i n) #(e 5 j o))
|
|
#(#(a 1 f k p) #(b 2 g l q) #(c 3 h m r) #(d 4 i n s) #(e 5 j o t))
|
|
#(#(a 1 f k p u) #(b 2 g l q v) #(c 3 h m r w) #(d 4 i n s x) #(e 5 j o t y))
|
|
#(#(1 a) #(2 b) #(3 c) #(4 d) #(5 e))
|
|
#(#(1 a f) #(2 b g) #(3 c h) #(4 d i) #(5 e j))
|
|
#(#(1 a f k) #(2 b g l) #(3 c h m) #(4 d i n) #(5 e j o))
|
|
#(#(1 a f k p) #(2 b g l q) #(3 c h m r) #(4 d i n s) #(5 e j o t))
|
|
#(#(1 a f k p u) #(2 b g l q v) #(3 c h m r w) #(4 d i n s x) #(5 e j o t y))
|
|
#(#(1 f a) #(2 g b) #(3 h c) #(4 i d) #(5 j e))
|
|
#(#(1 f a k) #(2 g b l) #(3 h c m) #(4 i d n) #(5 j e o))
|
|
#(#(1 f a k p) #(2 g b l q) #(3 h c m r) #(4 i d n s) #(5 j e o t))
|
|
#(#(1 f a k p u) #(2 g b l q v) #(3 h c m r w) #(4 i d n s x) #(5 j e o t y))
|
|
#(#(1 f k a) #(2 g l b) #(3 h m c) #(4 i n d) #(5 j o e))
|
|
#(#(1 f k a p) #(2 g l b q) #(3 h m c r) #(4 i n d s) #(5 j o e t))
|
|
#(#(1 f k a p u) #(2 g l b q v) #(3 h m c r w) #(4 i n d s x) #(5 j o e t y))
|
|
#(#(1 f k p a) #(2 g l q b) #(3 h m r c) #(4 i n s d) #(5 j o t e))
|
|
#(#(1 f k p a u) #(2 g l q b v) #(3 h m r c w) #(4 i n s d x) #(5 j o t e y))
|
|
#(#(1 f k p u a) #(2 g l q v b) #(3 h m r w c) #(4 i n s x d) #(5 j o t y e))))
|
|
)
|
|
|
|
(mat vector-for-each
|
|
(error? ; invalid number of arguments
|
|
(vector-for-each))
|
|
(error? ; invalid number of arguments
|
|
(vector-for-each '#()))
|
|
(error? ; invalid number of arguments
|
|
(vector-for-each +))
|
|
(error? ; non procedure '#()
|
|
(vector-for-each '#() '#()))
|
|
(error? ; non procedure '#()
|
|
(vector-for-each '#() '#() '#()))
|
|
(error? ; non procedure '#()
|
|
(vector-for-each '#() '#() '#() '()))
|
|
(error? ; non procedure '#()
|
|
(vector-for-each '#() '#() '#() '#() '#()))
|
|
(error? ; non vector 3
|
|
(vector-for-each + 3))
|
|
(error? ; non vector (3)
|
|
(vector-for-each + '#() '(3)))
|
|
(error? ; non vector (3)
|
|
(vector-for-each + '#() '#() '(3)))
|
|
(error? ; non vector (3)
|
|
(vector-for-each + '#() '#() '(3) '#()))
|
|
(error? ; non vector 7
|
|
(vector-for-each + 7 '#() '#() '#() '#()))
|
|
(error? ; lengths differ
|
|
(vector-for-each + '#() '#(x)))
|
|
(error? ; lengths differ
|
|
(vector-for-each + '#() '#() '#(x)))
|
|
(error? ; lengths differ
|
|
(vector-for-each + '#() '#() '#(x) '#()))
|
|
(error? ; lengths differ
|
|
(vector-for-each + '#(y) '#() '#(x) '#()))
|
|
(error? ; lengths differ
|
|
(vector-for-each + '#(y) '#() '#() '#() '#()))
|
|
(equal? (vector-for-each + '#()) (void))
|
|
(equal? (vector-for-each + '#() '#()) (void))
|
|
(equal? (vector-for-each + '#() '#() '#()) (void))
|
|
(equal? (vector-for-each + '#() '#() '#() '#() '#()) (void))
|
|
(equal?
|
|
(let ([ls '()])
|
|
(vector-for-each (lambda (x) (set! ls (cons x ls))) '#(a b c d e f))
|
|
ls)
|
|
'(f e d c b a))
|
|
(equal?
|
|
(let ([ls '()])
|
|
(vector-for-each
|
|
(lambda (x y) (set! ls (cons (cons x y) ls)))
|
|
'#(a b c d e f)
|
|
'#(3 2 7 6 5 4))
|
|
ls)
|
|
'((f . 4) (e . 5) (d . 6) (c . 7) (b . 2) (a . 3)))
|
|
(equal?
|
|
(let ([ls '()])
|
|
(vector-for-each
|
|
(lambda r (set! ls (cons r ls)))
|
|
'#(a b c d e f)
|
|
'#(3 2 7 6 5 4)
|
|
'#(-1 -2 -3 -4 -5 -6))
|
|
ls)
|
|
'((f 4 -6) (e 5 -5) (d 6 -4) (c 7 -3) (b 2 -2) (a 3 -1)))
|
|
(equal?
|
|
(let ([ls '()])
|
|
(vector-for-each
|
|
(lambda r (set! ls (cons r ls)))
|
|
'#(a b c d e f)
|
|
'#(3 2 7 6 5 4)
|
|
'#(-1 -2 -3 -4 -5 -6)
|
|
'#(m n o p q r)
|
|
'#(z y x w v u))
|
|
ls)
|
|
'((f 4 -6 r u) (e 5 -5 q v) (d 6 -4 p w) (c 7 -3 o x)
|
|
(b 2 -2 n y) (a 3 -1 m z)))
|
|
(begin
|
|
(define ($vector-for-each-f1 p x1 x2 x3 x4 x5)
|
|
(begin
|
|
(vector-for-each p '#())
|
|
(vector-for-each p '#() x1)
|
|
(vector-for-each p '#() x1 x2)
|
|
(vector-for-each p '#() x1 x2 x3)
|
|
(vector-for-each p '#() x1 x2 x3 x4)
|
|
(vector-for-each p '#() x1 x2 x3 x4 x5)
|
|
(vector-for-each p x1 '#())
|
|
(vector-for-each p x1 '#() x2)
|
|
(vector-for-each p x1 '#() x2 x3)
|
|
(vector-for-each p x1 '#() x2 x3 x4)
|
|
(vector-for-each p x1 '#() x2 x3 x4 x5)
|
|
(vector-for-each p x1 x2 '#())
|
|
(vector-for-each p x1 x2 '#() x3)
|
|
(vector-for-each p x1 x2 '#() x3 x4)
|
|
(vector-for-each p x1 x2 '#() x3 x4 x5)
|
|
(vector-for-each p x1 x2 x3 '#())
|
|
(vector-for-each p x1 x2 x3 '#() x4)
|
|
(vector-for-each p x1 x2 x3 '#() x4 x5)
|
|
(vector-for-each p x1 x2 x3 x4 '#())
|
|
(vector-for-each p x1 x2 x3 x4 '#() x5)
|
|
(vector-for-each p x1 x2 x3 x4 x5 '#())))
|
|
(procedure? $vector-for-each-f1))
|
|
(equal?
|
|
(let ([ls '()])
|
|
(define q (lambda args (set! ls (cons (reverse args) ls))))
|
|
($vector-for-each-f1 q '#() '#() '#() '#() '#())
|
|
(reverse ls))
|
|
'())
|
|
(begin
|
|
(define ($vector-for-each-f1 p x1 x2 x3 x4 x5)
|
|
(begin
|
|
(vector-for-each p '#(a))
|
|
(vector-for-each p '#(a) x1)
|
|
(vector-for-each p '#(a) x1 x2)
|
|
(vector-for-each p '#(a) x1 x2 x3)
|
|
(vector-for-each p '#(a) x1 x2 x3 x4)
|
|
(vector-for-each p '#(a) x1 x2 x3 x4 x5)
|
|
(vector-for-each p x1 '#(a))
|
|
(vector-for-each p x1 '#(a) x2)
|
|
(vector-for-each p x1 '#(a) x2 x3)
|
|
(vector-for-each p x1 '#(a) x2 x3 x4)
|
|
(vector-for-each p x1 '#(a) x2 x3 x4 x5)
|
|
(vector-for-each p x1 x2 '#(a))
|
|
(vector-for-each p x1 x2 '#(a) x3)
|
|
(vector-for-each p x1 x2 '#(a) x3 x4)
|
|
(vector-for-each p x1 x2 '#(a) x3 x4 x5)
|
|
(vector-for-each p x1 x2 x3 '#(a))
|
|
(vector-for-each p x1 x2 x3 '#(a) x4)
|
|
(vector-for-each p x1 x2 x3 '#(a) x4 x5)
|
|
(vector-for-each p x1 x2 x3 x4 '#(a))
|
|
(vector-for-each p x1 x2 x3 x4 '#(a) x5)
|
|
(vector-for-each p x1 x2 x3 x4 x5 '#(a))))
|
|
(procedure? $vector-for-each-f1))
|
|
(equal?
|
|
(let ([ls '()])
|
|
(define q (lambda args (set! ls (cons (reverse args) ls))))
|
|
($vector-for-each-f1 q '#(1) '#(f) '#(k) '#(p) '#(u))
|
|
(reverse ls))
|
|
'((a) (1 a) (f 1 a) (k f 1 a) (p k f 1 a) (u p k f 1 a)
|
|
(a 1) (f a 1) (k f a 1) (p k f a 1) (u p k f a 1)
|
|
(a f 1) (k a f 1) (p k a f 1) (u p k a f 1) (a k f 1)
|
|
(p a k f 1) (u p a k f 1) (a p k f 1) (u a p k f 1)
|
|
(a u p k f 1)))
|
|
(begin
|
|
(define ($vector-for-each-f1 p x1 x2 x3 x4 x5)
|
|
(begin
|
|
(vector-for-each p '#(a b))
|
|
(vector-for-each p '#(a b) x1)
|
|
(vector-for-each p '#(a b) x1 x2)
|
|
(vector-for-each p '#(a b) x1 x2 x3)
|
|
(vector-for-each p '#(a b) x1 x2 x3 x4)
|
|
(vector-for-each p '#(a b) x1 x2 x3 x4 x5)
|
|
(vector-for-each p x1 '#(a b))
|
|
(vector-for-each p x1 '#(a b) x2)
|
|
(vector-for-each p x1 '#(a b) x2 x3)
|
|
(vector-for-each p x1 '#(a b) x2 x3 x4)
|
|
(vector-for-each p x1 '#(a b) x2 x3 x4 x5)
|
|
(vector-for-each p x1 x2 '#(a b))
|
|
(vector-for-each p x1 x2 '#(a b) x3)
|
|
(vector-for-each p x1 x2 '#(a b) x3 x4)
|
|
(vector-for-each p x1 x2 '#(a b) x3 x4 x5)
|
|
(vector-for-each p x1 x2 x3 '#(a b))
|
|
(vector-for-each p x1 x2 x3 '#(a b) x4)
|
|
(vector-for-each p x1 x2 x3 '#(a b) x4 x5)
|
|
(vector-for-each p x1 x2 x3 x4 '#(a b))
|
|
(vector-for-each p x1 x2 x3 x4 '#(a b) x5)
|
|
(vector-for-each p x1 x2 x3 x4 x5 '#(a b))))
|
|
(procedure? $vector-for-each-f1))
|
|
(equal?
|
|
(let ([ls '()])
|
|
(define q (lambda args (set! ls (cons (reverse args) ls))))
|
|
($vector-for-each-f1 q '#(1 2) '#(f g) '#(k l) '#(p q) '#(u v))
|
|
(reverse ls))
|
|
'((a) (b) (1 a) (2 b) (f 1 a) (g 2 b) (k f 1 a)
|
|
(l g 2 b) (p k f 1 a) (q l g 2 b) (u p k f 1 a)
|
|
(v q l g 2 b) (a 1) (b 2) (f a 1) (g b 2) (k f a 1)
|
|
(l g b 2) (p k f a 1) (q l g b 2) (u p k f a 1)
|
|
(v q l g b 2) (a f 1) (b g 2) (k a f 1) (l b g 2)
|
|
(p k a f 1) (q l b g 2) (u p k a f 1) (v q l b g 2)
|
|
(a k f 1) (b l g 2) (p a k f 1) (q b l g 2)
|
|
(u p a k f 1) (v q b l g 2) (a p k f 1) (b q l g 2)
|
|
(u a p k f 1) (v b q l g 2) (a u p k f 1)
|
|
(b v q l g 2)))
|
|
(begin
|
|
(define ($vector-for-each-f1 p x1 x2 x3 x4 x5)
|
|
(begin
|
|
(vector-for-each p '#(a b c))
|
|
(vector-for-each p '#(a b c) x1)
|
|
(vector-for-each p '#(a b c) x1 x2)
|
|
(vector-for-each p '#(a b c) x1 x2 x3)
|
|
(vector-for-each p '#(a b c) x1 x2 x3 x4)
|
|
(vector-for-each p '#(a b c) x1 x2 x3 x4 x5)
|
|
(vector-for-each p x1 '#(a b c))
|
|
(vector-for-each p x1 '#(a b c) x2)
|
|
(vector-for-each p x1 '#(a b c) x2 x3)
|
|
(vector-for-each p x1 '#(a b c) x2 x3 x4)
|
|
(vector-for-each p x1 '#(a b c) x2 x3 x4 x5)
|
|
(vector-for-each p x1 x2 '#(a b c))
|
|
(vector-for-each p x1 x2 '#(a b c) x3)
|
|
(vector-for-each p x1 x2 '#(a b c) x3 x4)
|
|
(vector-for-each p x1 x2 '#(a b c) x3 x4 x5)
|
|
(vector-for-each p x1 x2 x3 '#(a b c))
|
|
(vector-for-each p x1 x2 x3 '#(a b c) x4)
|
|
(vector-for-each p x1 x2 x3 '#(a b c) x4 x5)
|
|
(vector-for-each p x1 x2 x3 x4 '#(a b c))
|
|
(vector-for-each p x1 x2 x3 x4 '#(a b c) x5)
|
|
(vector-for-each p x1 x2 x3 x4 x5 '#(a b c))))
|
|
(procedure? $vector-for-each-f1))
|
|
(equal?
|
|
(let ([ls '()])
|
|
(define q (lambda args (set! ls (cons (reverse args) ls))))
|
|
($vector-for-each-f1 q '#(1 2 3) '#(f g h) '#(k l m) '#(p q r) '#(u v w))
|
|
(reverse ls))
|
|
'((a) (b) (c) (1 a) (2 b) (3 c) (f 1 a) (g 2 b) (h 3 c)
|
|
(k f 1 a) (l g 2 b) (m h 3 c) (p k f 1 a) (q l g 2 b)
|
|
(r m h 3 c) (u p k f 1 a) (v q l g 2 b) (w r m h 3 c)
|
|
(a 1) (b 2) (c 3) (f a 1) (g b 2) (h c 3) (k f a 1)
|
|
(l g b 2) (m h c 3) (p k f a 1) (q l g b 2) (r m h c 3)
|
|
(u p k f a 1) (v q l g b 2) (w r m h c 3) (a f 1)
|
|
(b g 2) (c h 3) (k a f 1) (l b g 2) (m c h 3)
|
|
(p k a f 1) (q l b g 2) (r m c h 3) (u p k a f 1)
|
|
(v q l b g 2) (w r m c h 3) (a k f 1) (b l g 2)
|
|
(c m h 3) (p a k f 1) (q b l g 2) (r c m h 3)
|
|
(u p a k f 1) (v q b l g 2) (w r c m h 3) (a p k f 1)
|
|
(b q l g 2) (c r m h 3) (u a p k f 1) (v b q l g 2)
|
|
(w c r m h 3) (a u p k f 1) (b v q l g 2)
|
|
(c w r m h 3)))
|
|
(begin
|
|
(define ($vector-for-each-f1 p x1 x2 x3 x4 x5)
|
|
(begin
|
|
(vector-for-each p '#(a b c d))
|
|
(vector-for-each p '#(a b c d) x1)
|
|
(vector-for-each p '#(a b c d) x1 x2)
|
|
(vector-for-each p '#(a b c d) x1 x2 x3)
|
|
(vector-for-each p '#(a b c d) x1 x2 x3 x4)
|
|
(vector-for-each p '#(a b c d) x1 x2 x3 x4 x5)
|
|
(vector-for-each p x1 '#(a b c d))
|
|
(vector-for-each p x1 '#(a b c d) x2)
|
|
(vector-for-each p x1 '#(a b c d) x2 x3)
|
|
(vector-for-each p x1 '#(a b c d) x2 x3 x4)
|
|
(vector-for-each p x1 '#(a b c d) x2 x3 x4 x5)
|
|
(vector-for-each p x1 x2 '#(a b c d))
|
|
(vector-for-each p x1 x2 '#(a b c d) x3)
|
|
(vector-for-each p x1 x2 '#(a b c d) x3 x4)
|
|
(vector-for-each p x1 x2 '#(a b c d) x3 x4 x5)
|
|
(vector-for-each p x1 x2 x3 '#(a b c d))
|
|
(vector-for-each p x1 x2 x3 '#(a b c d) x4)
|
|
(vector-for-each p x1 x2 x3 '#(a b c d) x4 x5)
|
|
(vector-for-each p x1 x2 x3 x4 '#(a b c d))
|
|
(vector-for-each p x1 x2 x3 x4 '#(a b c d) x5)
|
|
(vector-for-each p x1 x2 x3 x4 x5 '#(a b c d))))
|
|
(procedure? $vector-for-each-f1))
|
|
(equal?
|
|
(let ([ls '()])
|
|
(define q (lambda args (set! ls (cons (reverse args) ls))))
|
|
($vector-for-each-f1 q '#(1 2 3 4) '#(f g h i) '#(k l m n) '#(p q r s) '#(u v w x))
|
|
(reverse ls))
|
|
'((a) (b) (c) (d) (1 a) (2 b) (3 c) (4 d) (f 1 a)
|
|
(g 2 b) (h 3 c) (i 4 d) (k f 1 a) (l g 2 b) (m h 3 c)
|
|
(n i 4 d) (p k f 1 a) (q l g 2 b) (r m h 3 c)
|
|
(s n i 4 d) (u p k f 1 a) (v q l g 2 b) (w r m h 3 c)
|
|
(x s n i 4 d) (a 1) (b 2) (c 3) (d 4) (f a 1) (g b 2)
|
|
(h c 3) (i d 4) (k f a 1) (l g b 2) (m h c 3) (n i d 4)
|
|
(p k f a 1) (q l g b 2) (r m h c 3) (s n i d 4)
|
|
(u p k f a 1) (v q l g b 2) (w r m h c 3) (x s n i d 4)
|
|
(a f 1) (b g 2) (c h 3) (d i 4) (k a f 1) (l b g 2)
|
|
(m c h 3) (n d i 4) (p k a f 1) (q l b g 2) (r m c h 3)
|
|
(s n d i 4) (u p k a f 1) (v q l b g 2) (w r m c h 3)
|
|
(x s n d i 4) (a k f 1) (b l g 2) (c m h 3) (d n i 4)
|
|
(p a k f 1) (q b l g 2) (r c m h 3) (s d n i 4)
|
|
(u p a k f 1) (v q b l g 2) (w r c m h 3) (x s d n i 4)
|
|
(a p k f 1) (b q l g 2) (c r m h 3) (d s n i 4)
|
|
(u a p k f 1) (v b q l g 2) (w c r m h 3) (x d s n i 4)
|
|
(a u p k f 1) (b v q l g 2) (c w r m h 3)
|
|
(d x s n i 4)))
|
|
(begin
|
|
(define ($vector-for-each-f1 p x1 x2 x3 x4 x5)
|
|
(begin
|
|
(vector-for-each p '#(a b c d e))
|
|
(vector-for-each p '#(a b c d e) x1)
|
|
(vector-for-each p '#(a b c d e) x1 x2)
|
|
(vector-for-each p '#(a b c d e) x1 x2 x3)
|
|
(vector-for-each p '#(a b c d e) x1 x2 x3 x4)
|
|
(vector-for-each p '#(a b c d e) x1 x2 x3 x4 x5)
|
|
(vector-for-each p x1 '#(a b c d e))
|
|
(vector-for-each p x1 '#(a b c d e) x2)
|
|
(vector-for-each p x1 '#(a b c d e) x2 x3)
|
|
(vector-for-each p x1 '#(a b c d e) x2 x3 x4)
|
|
(vector-for-each p x1 '#(a b c d e) x2 x3 x4 x5)
|
|
(vector-for-each p x1 x2 '#(a b c d e))
|
|
(vector-for-each p x1 x2 '#(a b c d e) x3)
|
|
(vector-for-each p x1 x2 '#(a b c d e) x3 x4)
|
|
(vector-for-each p x1 x2 '#(a b c d e) x3 x4 x5)
|
|
(vector-for-each p x1 x2 x3 '#(a b c d e))
|
|
(vector-for-each p x1 x2 x3 '#(a b c d e) x4)
|
|
(vector-for-each p x1 x2 x3 '#(a b c d e) x4 x5)
|
|
(vector-for-each p x1 x2 x3 x4 '#(a b c d e))
|
|
(vector-for-each p x1 x2 x3 x4 '#(a b c d e) x5)
|
|
(vector-for-each p x1 x2 x3 x4 x5 '#(a b c d e))))
|
|
(procedure? $vector-for-each-f1))
|
|
(equal?
|
|
(let ([ls '()])
|
|
(define q (lambda args (set! ls (cons (reverse args) ls))))
|
|
($vector-for-each-f1 q '#(1 2 3 4 5) '#(f g h i j) '#(k l m n o) '#(p q r s t) '#(u v w x y))
|
|
(reverse ls))
|
|
'((a) (b) (c) (d) (e) (1 a) (2 b) (3 c) (4 d) (5 e)
|
|
(f 1 a) (g 2 b) (h 3 c) (i 4 d) (j 5 e) (k f 1 a)
|
|
(l g 2 b) (m h 3 c) (n i 4 d) (o j 5 e) (p k f 1 a)
|
|
(q l g 2 b) (r m h 3 c) (s n i 4 d) (t o j 5 e)
|
|
(u p k f 1 a) (v q l g 2 b) (w r m h 3 c) (x s n i 4 d)
|
|
(y t o j 5 e) (a 1) (b 2) (c 3) (d 4) (e 5) (f a 1)
|
|
(g b 2) (h c 3) (i d 4) (j e 5) (k f a 1) (l g b 2)
|
|
(m h c 3) (n i d 4) (o j e 5) (p k f a 1) (q l g b 2)
|
|
(r m h c 3) (s n i d 4) (t o j e 5) (u p k f a 1)
|
|
(v q l g b 2) (w r m h c 3) (x s n i d 4) (y t o j e 5)
|
|
(a f 1) (b g 2) (c h 3) (d i 4) (e j 5) (k a f 1)
|
|
(l b g 2) (m c h 3) (n d i 4) (o e j 5) (p k a f 1)
|
|
(q l b g 2) (r m c h 3) (s n d i 4) (t o e j 5)
|
|
(u p k a f 1) (v q l b g 2) (w r m c h 3) (x s n d i 4)
|
|
(y t o e j 5) (a k f 1) (b l g 2) (c m h 3) (d n i 4)
|
|
(e o j 5) (p a k f 1) (q b l g 2) (r c m h 3)
|
|
(s d n i 4) (t e o j 5) (u p a k f 1) (v q b l g 2)
|
|
(w r c m h 3) (x s d n i 4) (y t e o j 5) (a p k f 1)
|
|
(b q l g 2) (c r m h 3) (d s n i 4) (e t o j 5)
|
|
(u a p k f 1) (v b q l g 2) (w c r m h 3) (x d s n i 4)
|
|
(y e t o j 5) (a u p k f 1) (b v q l g 2) (c w r m h 3)
|
|
(d x s n i 4) (e y t o j 5)))
|
|
; check for proper tail recursion
|
|
(equal?
|
|
(list
|
|
(let ([s (statistics)])
|
|
(let ([k 100000] [v '#(a b c)])
|
|
(let ([n k] [m 0])
|
|
(define (f) (unless (fx= n 0) (vector-for-each foo v)))
|
|
(define (foo x)
|
|
(set! m (+ m 1))
|
|
(when (eq? x (vector-ref v (fx- (vector-length v) 1)))
|
|
(set! n (- n 1))
|
|
(f)
|
|
17)) ; blow tail recursion here
|
|
(f)
|
|
(list (> (sstats-bytes (sstats-difference (statistics) s))
|
|
10000)
|
|
(eqv? n 0)
|
|
(eqv? m (* k (vector-length v)))))))
|
|
(let ([s (statistics)])
|
|
(let ([k 100000] [v '#(a b c)])
|
|
(let ([n k] [m 0])
|
|
(define (f) (unless (fx= n 0) (vector-for-each foo v)))
|
|
(define (foo x)
|
|
(set! m (+ m 1))
|
|
(when (eq? x (vector-ref v (fx- (vector-length v) 1)))
|
|
(set! n (- n 1))
|
|
(f)))
|
|
(f)
|
|
(list (<= 0
|
|
(sstats-bytes (sstats-difference (statistics) s))
|
|
1000)
|
|
(eqv? n 0)
|
|
(eqv? m (* k (vector-length v))))))))
|
|
'((#t #t #t) (#t #t #t)))
|
|
)
|
|
|
|
(define $merge-sort
|
|
(lambda (lt? ls)
|
|
(define merge
|
|
(lambda (ls1 ls2)
|
|
(if (null? ls1)
|
|
ls2
|
|
(if (null? ls2)
|
|
ls1
|
|
(if (lt? (car ls1) (car ls2))
|
|
(cons (car ls1) (merge (cdr ls1) ls2))
|
|
(cons (car ls2) (merge ls1 (cdr ls2))))))))
|
|
(define sort
|
|
(lambda (ls n)
|
|
(if (fx<= n 1)
|
|
ls
|
|
(let ([mid (quotient n 2)])
|
|
(merge
|
|
(sort (list-head ls mid) mid)
|
|
(sort (list-tail ls mid) (fx- n mid)))))))
|
|
(sort ls (length ls))))
|
|
|
|
(mat vector-sort
|
|
(error? ; invalid number of arguments
|
|
(vector-sort))
|
|
(error? ; invalid number of arguments
|
|
(vector-sort >))
|
|
(error? ; invalid number of arguments
|
|
(vector-sort '#(a b c)))
|
|
(error? ; invalid number of arguments
|
|
(vector-sort > '#(1 2 3) #t))
|
|
(error? ; 3 is not a proper list
|
|
(vector-sort > 3))
|
|
(error? ; (1 2 3) is not a vector
|
|
(vector-sort > '(1 2 3)))
|
|
(error? ; #(a b c) is not a procedure
|
|
(vector-sort '#(a b c) '#(a b c)))
|
|
(error? ; b is not a real number
|
|
(vector-sort > '#(1 b 3)))
|
|
(equal? (vector-sort > '#()) '#())
|
|
(let ([v (vector 3 2 1)])
|
|
(and
|
|
(equal? (vector-sort > v) '#(3 2 1))
|
|
(equal? v '#(3 2 1))))
|
|
(let ([v (vector 1 2 3)])
|
|
(and
|
|
(equal? (vector-sort > v) '#(3 2 1))
|
|
(equal? v '#(1 2 3))))
|
|
(let ([v (vector 2 3 1)])
|
|
(and
|
|
(equal? (vector-sort > v) '#(3 2 1))
|
|
(equal? v '#(2 3 1))))
|
|
(let ([v (vector -2 3.0 9 8 3 -11 0 9 -5 -7 -43 8.0 5)])
|
|
(and
|
|
(equal?
|
|
(vector-sort < v)
|
|
'#(-43 -11 -7 -5 -2 0 3.0 3 5 8 8.0 9 9))
|
|
(equal? v '#(-2 3.0 9 8 3 -11 0 9 -5 -7 -43 8.0 5))))
|
|
(let ([v (vector 2 5 8 -3 9 10 -5 8 -8 4 2 3 1 -1 -9)])
|
|
(and
|
|
(equal?
|
|
(vector-sort (lambda (x y) (< (abs x) (abs y))) v)
|
|
'#(1 -1 2 2 -3 3 4 5 -5 8 8 -8 9 -9 10))
|
|
(equal? v '#(2 5 8 -3 9 10 -5 8 -8 4 2 3 1 -1 -9))))
|
|
(let ([v (vector 1 3 2 4)])
|
|
(and
|
|
(equal? (vector-sort < v) '#(1 2 3 4))
|
|
(equal? v '#(1 3 2 4))))
|
|
(equal?
|
|
(with-output-to-string
|
|
(lambda ()
|
|
(do ([n 1000 (fx- n 5)])
|
|
((fx= n 0))
|
|
(write-char #\.)
|
|
(flush-output-port)
|
|
(do ([k 25 (fx- k 1)])
|
|
((fx= k 0))
|
|
(let ([ls (map (lambda (x) (random k)) (make-list n))])
|
|
(unless (let ([v (list->vector ls)])
|
|
(and
|
|
(equal?
|
|
(vector-sort < v)
|
|
(list->vector ($merge-sort < ls)))
|
|
(equal? v (list->vector ls))))
|
|
(fprintf (console-output-port) "\n~s\n" ls)
|
|
(errorf #f "failed")))))))
|
|
(make-string 200 #\.))
|
|
)
|
|
|
|
(mat vector-sort!
|
|
(error? ; invalid number of arguments
|
|
(vector-sort!))
|
|
(error? ; invalid number of arguments
|
|
(vector-sort! >))
|
|
(error? ; invalid number of arguments
|
|
(vector-sort! '#(a b c)))
|
|
(error? ; invalid number of arguments
|
|
(vector-sort! > '#(1 2 3) #t))
|
|
(error? ; 3 is not a proper list
|
|
(vector-sort! > 3))
|
|
(error? ; (1 2 3) is not a vector
|
|
(vector-sort! > '(1 2 3)))
|
|
(error? ; #(a b c) is not a procedure
|
|
(vector-sort! '#(a b c) '#(a b c)))
|
|
(error? ; b is not a real number
|
|
(vector-sort! > '#(1 b 3)))
|
|
(equal? (vector-sort! > '#()) (void))
|
|
(let ([v (vector 3 2 1)])
|
|
(and
|
|
(equal? (vector-sort! > v) (void))
|
|
(equal? v '#(3 2 1))))
|
|
(let ([v (vector 1 2 3)])
|
|
(and
|
|
(equal? (vector-sort! > v) (void))
|
|
(equal? v '#(3 2 1))))
|
|
(let ([v (vector 2 3 1)])
|
|
(and
|
|
(equal? (vector-sort! > v) (void))
|
|
(equal? v '#(3 2 1))))
|
|
(let ([v (vector -2 3.0 9 8 3 -11 0 9 -5 -7 -43 8.0 5)])
|
|
(and
|
|
(equal?
|
|
(vector-sort! < v)
|
|
(void))
|
|
(equal? v '#(-43 -11 -7 -5 -2 0 3.0 3 5 8 8.0 9 9))))
|
|
(let ([v (vector 2 5 8 -3 9 10 -5 8 -8 4 2 3 1 -1 -9)])
|
|
(and
|
|
(equal?
|
|
(vector-sort! (lambda (x y) (< (abs x) (abs y))) v)
|
|
(void))
|
|
(equal? v '#(1 -1 2 2 -3 3 4 5 -5 8 8 -8 9 -9 10))))
|
|
(let ([v (vector 1 3 2 4)])
|
|
(and
|
|
(equal? (vector-sort! < v) (void))
|
|
(equal? v '#(1 2 3 4))))
|
|
(equal?
|
|
(with-output-to-string
|
|
(lambda ()
|
|
(do ([n 1000 (fx- n 5)])
|
|
((fx= n 0))
|
|
(write-char #\.)
|
|
(flush-output-port)
|
|
(do ([k 25 (fx- k 1)])
|
|
((fx= k 0))
|
|
(let ([ls (map (lambda (x) (random k)) (make-list n))])
|
|
(unless (let ([v (list->vector ls)])
|
|
(and
|
|
(equal? (vector-sort! < v) (void))
|
|
(equal? v (list->vector ($merge-sort < ls)))))
|
|
(fprintf (console-output-port) "\n~s\n" ls)
|
|
(errorf #f "failed")))))))
|
|
(make-string 200 #\.))
|
|
)
|
|
|
|
(mat vector->immutable-vector
|
|
(begin
|
|
(define immutable-123-vector
|
|
(vector->immutable-vector (vector 1 2 3)))
|
|
#t)
|
|
|
|
(immutable-vector? immutable-123-vector)
|
|
(not (mutable-vector? immutable-123-vector))
|
|
|
|
(equal? '#(1 2 3) immutable-123-vector)
|
|
(eq? immutable-123-vector
|
|
(vector->immutable-vector immutable-123-vector))
|
|
|
|
(mutable-vector? (make-vector 5))
|
|
(not (immutable-vector? (make-vector 5)))
|
|
|
|
(immutable-vector? (vector->immutable-vector (vector)))
|
|
(not (mutable-vector? (vector->immutable-vector (vector))))
|
|
(not (immutable-vector? (vector)))
|
|
(mutable-vector? (vector))
|
|
|
|
(not (immutable-vector? (vector-copy immutable-123-vector)))
|
|
|
|
(error? (vector-set! immutable-123-vector 0 1))
|
|
(error? (vector-set-fixnum! immutable-123-vector 0 1))
|
|
(error? (vector-fill! immutable-123-vector 0))
|
|
(error? (vector-sort! < immutable-123-vector))
|
|
)
|
|
|
|
|
|
|
|
(mat fxvector->immutable-fxvector
|
|
(begin
|
|
(define immutable-123-fxvector
|
|
(fxvector->immutable-fxvector (fxvector 1 2 3)))
|
|
#t)
|
|
|
|
(immutable-fxvector? immutable-123-fxvector)
|
|
(not (mutable-fxvector? immutable-123-fxvector))
|
|
|
|
(equal? '#vfx(1 2 3) immutable-123-fxvector)
|
|
(eq? immutable-123-fxvector
|
|
(fxvector->immutable-fxvector immutable-123-fxvector))
|
|
|
|
(mutable-fxvector? (make-fxvector 5))
|
|
(not (immutable-fxvector? (make-fxvector 5)))
|
|
|
|
(immutable-fxvector? (fxvector->immutable-fxvector (fxvector)))
|
|
(not (mutable-fxvector? (fxvector->immutable-fxvector (fxvector))))
|
|
(not (immutable-fxvector? (fxvector)))
|
|
(mutable-fxvector? (fxvector))
|
|
|
|
(not (immutable-fxvector? (fxvector-copy immutable-123-fxvector)))
|
|
|
|
(error? (fxvector-set! immutable-123-fxvector 0 1))
|
|
(error? (fxvector-fill! immutable-123-fxvector 0))
|
|
)
|
|
|
|
(mat vector-cas!
|
|
(begin
|
|
(define vec1 (vector 1 2 3))
|
|
(define vec2 (vector 'apple 'banana 'coconut))
|
|
(eq? 1 (vector-ref vec1 0)))
|
|
(not (vector-cas! vec1 0 0 1))
|
|
(eq? 1 (vector-ref vec1 0))
|
|
(vector-cas! vec1 0 1 4)
|
|
(eq? 4 (vector-ref vec1 0))
|
|
(not (vector-cas! vec1 0 1 5))
|
|
|
|
(not (vector-cas! vec1 1 0 1))
|
|
(eq? 2 (vector-ref vec1 1))
|
|
(vector-cas! vec1 1 2 5)
|
|
(eq? 5 (vector-ref vec1 1))
|
|
|
|
(not (vector-cas! vec2 0 'banana 'donut))
|
|
(vector-cas! vec2 0 'apple 'donut)
|
|
(not (vector-cas! vec2 0 'apple 'eclair))
|
|
(eq? 'donut (vector-ref vec2 0))
|
|
|
|
(not (vector-cas! vec2 1 'apple 'fig))
|
|
(vector-cas! vec2 1 'banana 'fig)
|
|
(not (vector-cas! vec2 1 'banana 'grape))
|
|
(eq? 'fig (vector-ref vec2 1))
|
|
|
|
(error? (vector-cas! vec1)) ; arity
|
|
(error? (vector-cas! vec1 1)) ; arity
|
|
(error? (vector-cas! vec1 1 2)) ; arity
|
|
(error? (vector-cas! 1 vec1 2 3)) ; not a vector
|
|
(error? (vector-cas! (vector->immutable-vector vec1) 1 2 3)) ; not a mutable vector
|
|
(error? (vector-cas! vec1 vec1 2 3)) ; not a fixnum
|
|
(error? (vector-cas! vec1 (expt 2 100) 2 3)) ; not a fixnum
|
|
(error? (vector-cas! vec1 -1 2 3)) ; out of range
|
|
(error? (vector-cas! vec1 5 2 3)) ; out of range
|
|
|
|
;; make sure `vector-cas!` works with GC generations:
|
|
(begin
|
|
(collect 0)
|
|
(let ([g1 (gensym)])
|
|
(and (vector-cas! vec2 2 'coconut g1)
|
|
(begin
|
|
(collect 0)
|
|
(eq? g1 (vector-ref vec2 2))))))
|
|
)
|