;;; 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)))))) )