This repository has been archived on 2022-08-10. You can view files and clone it, but cannot push or open issues or pull requests.
chez-openbsd/mats/5_2.ms

1341 lines
45 KiB
Scheme
Raw Normal View History

2022-07-29 15:12:07 +02:00
;;; 5-2.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.
(define (make-cyclic-list)
(let ((ls (list 'a 'b)))
(set-cdr! (last-pair ls) ls)
ls))
(define cyclic-list (make-cyclic-list))
(define cyclic-alist
(let ((ls (list '(a . 1) '(b . 2) '(3.2 . 3) '("a" . 4))))
(set-cdr! (last-pair ls) ls)
ls))
(mat cons
(equal? (cons 3 4) '(3 . 4))
(equal? (cons 3 '(a)) '(3 a))
(not (equal? (cons 2 3) (cons 3 2)))
)
(mat car
(eq? (car '(a b c)) 'a)
(eq? (car (cons 'a 'b)) 'a)
(error? (car "hi"))
)
(mat cdr
(equal? (cdr '(a b c)) '(b c))
(eq? (cdr (cons 'a 'b)) 'b)
(null? (cdr (cons 'a '())))
(error? (cdr 3))
)
(mat set-car!
(let ((x (list 'a 'b))) (set-car! x 3) (equal? x '(3 b)))
(error? (set-car! 'a 'b))
)
(mat set-cdr!
(let ((x (list 'a 'b))) (set-cdr! x 3) (equal? x '(a . 3)))
(error? (set-cdr! 'a 'b))
)
(set! bush
(lambda (n)
(let f ((n n) (x '()))
(if (zero? n)
x
(cons (f (1- n) (cons 'a x)) (f (1- n) (cons 'd x)))))))
(set! b2 (bush 2))
(set! b3 (bush 3))
(set! b4 (bush 4))
(mat c....r
;first, get some confidence in bush
(equal? b2 '(((a a) d a) (a d) d d))
(equal? (caar b2) '(a a))
(equal? (cadr b2) '(a d))
(equal? (cdar b2) '(d a))
(equal? (cddr b2) '(d d))
(equal? (caaar b3) '(a a a))
(equal? (caadr b3) '(a a d))
(equal? (cadar b3) '(a d a))
(equal? (caddr b3) '(a d d))
(equal? (cdaar b3) '(d a a))
(equal? (cdadr b3) '(d a d))
(equal? (cddar b3) '(d d a))
(equal? (cdddr b3) '(d d d))
(equal? (caaaar b4) '(a a a a))
(equal? (caaadr b4) '(a a a d))
(equal? (caadar b4) '(a a d a))
(equal? (caaddr b4) '(a a d d))
(equal? (cadaar b4) '(a d a a))
(equal? (cadadr b4) '(a d a d))
(equal? (caddar b4) '(a d d a))
(equal? (cadddr b4) '(a d d d))
(equal? (cdaaar b4) '(d a a a))
(equal? (cdaadr b4) '(d a a d))
(equal? (cdadar b4) '(d a d a))
(equal? (cdaddr b4) '(d a d d))
(equal? (cddaar b4) '(d d a a))
(equal? (cddadr b4) '(d d a d))
(equal? (cdddar b4) '(d d d a))
(equal? (cddddr b4) '(d d d d))
)
(define a.b '(a . b))
(mat c....r-errors
(error? (caar a.b))
(error? (cadr a.b))
(error? (cdar a.b))
(error? (cddr a.b))
(error? (caaar a.b))
(error? (caadr a.b))
(error? (cadar a.b))
(error? (caddr a.b))
(error? (cdaar a.b))
(error? (cdadr a.b))
(error? (cddar a.b))
(error? (cdddr a.b))
(error? (caaaar a.b))
(error? (caaadr a.b))
(error? (caadar a.b))
(error? (caaddr a.b))
(error? (cadaar a.b))
(error? (cadadr a.b))
(error? (caddar a.b))
(error? (cadddr a.b))
(error? (cdaaar a.b))
(error? (cdaadr a.b))
(error? (cdadar a.b))
(error? (cdaddr a.b))
(error? (cddaar a.b))
(error? (cddadr a.b))
(error? (cdddar a.b))
(error? (cddddr a.b))
)
(mat make-list
(equal? (length (make-list 15)) 15)
(equal? (make-list 3 'a) '(a a a))
(null? (make-list 0 0))
)
(mat list
(equal? (list 1 2 3 4) '(1 2 3 4))
(null? (list))
)
(mat list*
(error? (list*))
(equal? (list* 1) 1)
(equal? (list* (list 1 2 3)) '(1 2 3))
(equal? (list* 1 2 3 4) '(1 2 3 . 4))
(equal?
(list* 1 2 (list* 3 4 5) (list* 6 7 8))
'(1 2 (3 4 . 5) 6 7 . 8))
(not (list* #f))
(eq? (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2]) (expand/optimize '(not (list* #f)))) #t)
)
(mat cons*
(error? (cons*))
(equal? (cons* 1) 1)
(equal? (cons* (list 1 2 3)) '(1 2 3))
(equal? (cons* 1 2 3 4) '(1 2 3 . 4))
(equal?
(cons* 1 2 (list* 3 4 5) (list* 6 7 8))
'(1 2 (3 4 . 5) 6 7 . 8))
(not (cons* #f))
(eq? (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2]) (expand/optimize '(not (cons* #f)))) #t)
)
(mat length
(= (length '(1 2 3 4 5)) 5)
(= (length '()) 0)
; check that expand-primitives doesn't generate incorrect code.
; we don't check that it optimizes, however.
(let ([ls* (map make-list '(0 1 2 3 4 5 8 9 10 99 100 101 1000))])
(define-syntax test1
(syntax-rules ()
[(_ prim)
(let ()
(define (f x)
(and
(prim (#3%length x))
(prim (#3%length x))))
(andmap
(lambda (x)
(let ([n (length x)])
(equal?
(f x)
(prim n))))
ls*))]))
(define-syntax test2
(syntax-rules ()
[(_ prim)
(let ()
(define (f x)
(list
(prim (#3%length x) 0)
(prim 0 (#3%length x))
(prim (#3%length x) 1)
(prim 1 (#3%length x))
(prim (#3%length x) 4)
(prim 4 (#3%length x))
(prim (#3%length x) 9)
(prim 9 (#3%length x))
(prim (#3%length x) 100)
(prim 100 (#3%length x))))
(andmap
(lambda (x)
(let ([n (length x)])
(equal?
(f x)
(list
(prim n 0)
(prim 0 n)
(prim n 1)
(prim 1 n)
(prim n 4)
(prim 4 n)
(prim n 9)
(prim 9 n)
(prim n 100)
(prim 100 n)))))
ls*))]))
(and
(test1 zero?)
(test1 positive?)
(test1 nonnegative?)
(test1 negative?)
(test1 nonpositive?)
(test1 fxzero?)
(test1 fxpositive?)
(test1 fxnonnegative?)
(test1 fxnegative?)
(test1 fxnonpositive?)
(test2 eq?)
(test2 eqv?)
(test2 equal?)
(test2 <)
(test2 <=)
(test2 =)
(test2 >=)
(test2 >)
(test2 r6rs:<)
(test2 r6rs:<=)
(test2 r6rs:=)
(test2 r6rs:>=)
(test2 r6rs:>)
(test2 r6rs:<)
(test2 r6rs:<=)
(test2 r6rs:=)
(test2 r6rs:>=)
(test2 r6rs:>)
(test2 fx<)
(test2 fx<=)
(test2 fx=)
(test2 fx>=)
(test2 fx>)
(test2 fx<?)
(test2 fx<=?)
(test2 fx=?)
(test2 fx>=?)
(test2 fx>?)
(test2 #%$fxu<)))
)
(mat list-ref
(eq? (list-ref '(a b c d e) 3) 'd)
(eq? (list-ref '(a b c d e) 4) 'e)
(eq? (list-ref '(a b) 0) 'a)
(eq? (list-ref '(a b . c) 1) 'b)
(eq? (list-ref cyclic-list 20) 'a)
(eq? (list-ref cyclic-list 21) 'b)
(eq? (list-ref cyclic-list 10000) 'a)
(eq? (list-ref cyclic-list 10001) 'b)
(eq? (list-ref cyclic-list (expt 2 1000)) 'a)
(eq? (list-ref cyclic-list (+ (expt 2 1000) 1)) 'b)
(eq? (list-ref `(1 2 . ,cyclic-list) 20) 'a)
(eq? (list-ref `(1 2 . ,cyclic-list) 21) 'b)
(eq? (list-ref `(1 2 . ,cyclic-list) 10000) 'a)
(eq? (list-ref `(1 2 . ,cyclic-list) 10001) 'b)
(eq? (list-ref `(1 2 . ,cyclic-list) (expt 2 1000)) 'a)
(eq? (list-ref `(1 2 . ,cyclic-list) (+ (expt 2 1000) 1)) 'b)
(error? (list-ref 'a 0))
(error? (list-ref '(a b . c) 4))
(error? (list-ref '(a b) 4))
(error? (list-ref '(a b c) 4))
(error? (list-ref '(a b c d) 4))
(error? (list-ref '(a b c . e) 4))
(error? (list-ref '(a b c d . e) 4))
(error? (list-ref '(a b c d) 5))
(error? (list-ref '(a b c d e) 5))
(error? (list-ref '(a b c d e . f) 5))
(error? (list-ref '(a b . c) 10000))
(error? (list-ref '(a b c) 10000))
(error? (list-ref '(a b . c) 444444444444444444444444444444444444444444))
(error? (list-ref '(a b c) 444444444444444444444444444444444444444444))
(error? (list-ref '(a b c) -1))
(error? (list-ref '(a b c) -4444444444444444444444))
(error? (list-ref '(a b c) 'a))
)
(mat list-tail
(let ((x '(d e f))) (eq? (list-tail (list* 'a 'b x) 2) x))
(let ((x '(d e f))) (eq? (list-tail (list* 'a 'b x) 3) (cdr x)))
(let ((x '(a b c))) (eq? (list-tail x 0) x))
(null? (list-tail '(a b c) 3))
(eq? (list-tail '(a b . c) 2) 'c)
(eq? (list-tail cyclic-list 20) cyclic-list)
(eq? (list-tail cyclic-list 21) (cdr cyclic-list))
(eq? (list-tail cyclic-list 10000) cyclic-list)
(eq? (list-tail cyclic-list 10001) (cdr cyclic-list))
(eq? (list-tail cyclic-list (expt 2 1000)) cyclic-list)
(eq? (list-tail cyclic-list (+ (expt 2 1000) 1)) (cdr cyclic-list))
(eq? (list-tail `(1 2 . ,cyclic-list) 20) cyclic-list)
(eq? (list-tail `(1 2 . ,cyclic-list) 21) (cdr cyclic-list))
(eq? (list-tail `(1 2 . ,cyclic-list) 10000) cyclic-list)
(eq? (list-tail `(1 2 . ,cyclic-list) 10001) (cdr cyclic-list))
(eq? (list-tail `(1 2 . ,cyclic-list) (expt 2 1000)) cyclic-list)
(eq? (list-tail `(1 2 . ,cyclic-list) (+ (expt 2 1000) 1))
(cdr cyclic-list))
(eq? (list-tail 'a 0) 'a)
(error? (list-tail '(a b . c) 4))
(error? (list-tail '(a b c . d) 4))
(error? (list-tail '(a b . c) 5))
(error? (list-tail '(a b c . d) 5))
(error? (list-tail '(a b c d . e) 5))
(error? (list-tail '(a) 4))
(error? (list-tail '(a b) 4))
(error? (list-tail '(a b c) 4))
(error? (list-tail '(a b) 5))
(error? (list-tail '(a b c) 5))
(error? (list-tail '(a b c d) 5))
(error? (list-tail '(a b . c) 10000))
(error? (list-tail '(a b c) 10000))
(error? (list-tail '(a b . c) 444444444444444444444444444444444444444444))
(error? (list-tail '(a b c) 444444444444444444444444444444444444444444))
(error? (list-tail '(a b c) -1))
(error? (list-tail '(a b c) -4444444444444444444444))
(error? (list-tail '(a b c) 'a))
)
(mat list-head
(equal? (list-head '(a b c) 3) '(a b c))
(equal? (list-head '(a b . c) 2) '(a b))
(equal? (list-head cyclic-list 0) '())
(equal? (list-head cyclic-list 1) '(a))
(equal? (list-head cyclic-list 2) '(a b))
(equal? (list-head cyclic-list 20) '(a b a b a b a b a b a b a b a b a b a b))
(equal? (list-head cyclic-list 21) '(a b a b a b a b a b a b a b a b a b a b a))
(equal?
(let ([ls (list-head cyclic-list 10000)])
(list (length ls)
(length (remq 'a ls))
(length (remq 'b ls))
(last-pair ls)))
'(10000 5000 5000 (b)))
(equal?
(let ([ls (list-head cyclic-list 10001)])
(list (length ls)
(length (remq 'a ls))
(length (remq 'b ls))
(last-pair ls)))
'(10001 5000 5001 (a)))
(error? (list-head '(a . b) 3))
(error? (list-head '(a b . c) 3))
(equal? (list-head '(a b c . d) 3) '(a b c))
(error? (list-head '(a b . c) 4))
(error? (list-head '(a b c . d) 4))
(equal? (list-head '(a b c d . e) 4) '(a b c d))
(error? (list-head '(a b . c) 10000))
(error? (list-head '(a b c) 4))
(error? (list-head '(a b c) 5))
(error? (list-head '(a b c d) 5))
(error? (list-head '(a b c d) 6))
(error? (list-head '(a b c) 10000))
(error? (list-head '(a b c) 10001))
(error? (list-head '(a b c d) 10000))
(error? (list-head '(a b c d) 10001))
(error? (list-head '(a b c) -1))
(error? (list-head '(a b c) -2))
(error? (list-head '(a b c) 4444444444444444444444))
(error? (list-head '(a b c) -4444444444444444444445))
(error? (list-head '(a b c) 'a))
(error? (list-head '(a b c) 2.0))
)
(mat last-pair
(let ([x '(d e f)])
(eq? (last-pair x) (cddr x)))
(let ([x (cons 'c 'd)])
(let ([y (list* 'a 'b x)])
(eq? (last-pair y) x)))
(error? (last-pair cyclic-list))
(error? (last-pair (cdr cyclic-list)))
(error? (last-pair `(a b c . ,cyclic-list)))
)
(mat list-copy
(eq? (list-copy '()) '())
(equal? (list-copy '(a b c)) '(a b c))
(let* ((p1 '(a b c)) (p2 (cdr p1)) (p3 (cdr p2)))
(let ((c1 (list-copy p1)))
(not
(or (memq c1 (list p1 p2 p3))
(memq (cdr c1) (list p1 p2 p3))
(memq (cddr c1) (list p1 p2 p3))))))
(error? (list-copy '#(a b c)))
(error? (list-copy '(a b . c)))
(error? (list-copy cyclic-list))
(error? (list-copy (cdr cyclic-list)))
(error? (list-copy `(a b c . ,cyclic-list)))
)
(mat append
(null? (append))
(equal? (append '(a b c)) '(a b c))
(let ((x '(a b c)) (y '(d e f)))
(let ((z (append x y)))
(and (equal? x '(a b c))
(equal? y '(d e f))
(equal? z '(a b c d e f)))))
(let ((x '(a b c)))
(equal? (append '(a b c) '()) '(a b c)))
(let ((x '(d e f)))
(eq? (list-tail (append '(a b c) x) 3) x))
(equal? (append '(a b) '(c d) '(e f)) '(a b c d e f))
(error? (append cyclic-list '()))
(error? (append (cdr cyclic-list) '()))
(error? (append '(a b . c) '()))
(error? (append `(c d . ,cyclic-list) '()))
(error? (append '(a b) cyclic-list '()))
(error? (append '(a b) (cdr cyclic-list) '()))
(error? (append '(a b) `(c d . ,cyclic-list) '()))
(error? (append '(a b) '(a b . c) '()))
(error? (append '(1) '(a b) cyclic-list '()))
(error? (append '(1) '(a b) (cdr cyclic-list) '()))
(error? (append '() '(a b) `(c d . ,cyclic-list) '()))
(error? (append '(1) '(a b) '(a b . c) '()))
(not (append #f))
(eq? (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2]) (expand/optimize '(not (append #f)))) #t)
)
(mat append!
(null? (append!))
(equal? (append! (list 'a 'b 'c)) '(a b c))
(let ((x (list 'a 'b 'c)) (y (list 'd 'e 'f)))
(and (eq? x (append! x y)) (eq? y (list-tail x 3))))
(equal? (append! (list 'a 'b 'c) '()) '(a b c))
(equal? (append! '() '(a b c)) '(a b c))
(equal? (append! (list 'a 'b) (list 'c 'd) '(e f)) '(a b c d e f))
(error? (append! cyclic-list '()))
(error? (append! (cdr (make-cyclic-list)) '()))
(error? (append! (cons* 'c 'd (make-cyclic-list)) '()))
(error? (append! (cons* 'a 'b 'c) '()))
(error? (append! (list 'a 'b) (make-cyclic-list) '()))
(error? (append! (list 'a 'b) (cdr (make-cyclic-list)) '()))
(error? (append! (list 'a 'b) (cons* 'c 'd (make-cyclic-list)) '()))
(error? (append! (list 'a 'b) (cons* 'a 'b 'c) '()))
(error? (append! (list 1) (list 'a 'b) (make-cyclic-list) '()))
(error? (append! (list 1) (list 'a 'b) (cdr (make-cyclic-list)) '()))
(error? (append! (list 1) (list 'a 'b) (cons* 'c 'd (make-cyclic-list)) '()))
(error? (append! (list 1) (list 'a 'b) (cons* 'a 'b 'c) '()))
(not (append! #f))
(eq? (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2]) (expand/optimize '(not (append! #f)))) #t)
)
(mat reverse
(let* ((x '(a b c d)) (y (reverse x)))
(and (equal? x '(a b c d)) (equal? y '(d c b a))))
(eq? (reverse '()) '())
(equal? (reverse '(a)) '(a))
(error? (reverse))
(error? (reverse 'a))
(error? (reverse '(a b . c)))
(error? (reverse cyclic-list))
(error? (reverse (cdr cyclic-list)))
(error? (reverse `(a b . ,cyclic-list)))
)
(mat reverse!
(let* ((x (list 'a 'b 'c 'd)) (y (reverse! x)))
(and (not (equal? x '(a b c d))) (equal? y '(d c b a))))
(let ([memq? (lambda (x ls) (and (memq x ls) #t))])
(let* ((p1 (list 'a 'b 'c)) (p2 (cdr p1)) (p3 (cdr p2)))
(let* ((r1 (reverse! p1)) (r2 (cdr r1)) (r3 (cdr r2)))
(let ((p-pairs (list p1 p2 p3)))
(and (memq? r1 p-pairs) (memq? r2 p-pairs) (memq? r3 p-pairs))))))
(eq? (reverse! '()) '())
(let ((x '(a))) (eq? (reverse! x) x))
(error? (reverse!))
(error? (reverse! 'a))
(error? (reverse! (cons* 'a 'b 'c)))
(error? (reverse! (make-cyclic-list)))
(error? (reverse! (cdr (make-cyclic-list))))
(error? (reverse! (cons* 'a 'b (make-cyclic-list))))
)
(mat memp
(not (memp (lambda (x) #t) '()))
(let ([x '(a b c)])
(and (equal? (memp (lambda (x) (eq? x 'a)) x) x)
(equal? (memp (lambda (x) (eq? x 'b)) x) (cdr x))
(equal? (memp (lambda (x) (eq? x 'c)) x) (cddr x))
(not (memp (lambda (x) (eq? x 'd)) x))))
(let ([x '(1 -2 3)])
(and (equal? (memp negative? x) (cdr x))
(equal? (memp positive? x) x)
(not (memp pair? x))))
(equal? (memp (lambda (x) (eq? x 'a)) (cdr cyclic-list)) cyclic-list)
(error? ; cyclic list
(memp (lambda (x) #f) cyclic-list))
(error? ; improper list
(memp (lambda (x) #f) '(a b . c)))
(error? ; not a procedure
(memp 'a '(a b c)))
)
(mat find
(not (find (lambda (x) #t) '()))
(let ([x '(a b c)])
(and (equal? (find (lambda (x) (eq? x 'a)) x) 'a)
(equal? (find (lambda (x) (eq? x 'b)) x) 'b)
(equal? (find (lambda (x) (eq? x 'c)) x) 'c)
(not (find (lambda (x) (eq? x 'd)) x))))
(let ([x '(1 -2 3)])
(and (equal? (find negative? x) -2)
(equal? (find positive? x) 1)
(not (find pair? x))))
(equal? (find (lambda (x) (eq? x 'a)) (cdr cyclic-list)) 'a)
(error? ; cyclic list
(find (lambda (x) #f) cyclic-list))
(error? ; improper list
(find (lambda (x) #f) '(a b . c)))
(error? ; improper list
(find (lambda (x) #f) '(a b c . d)))
(error? ; not a procedure
(find 'a '(a b c)))
)
(mat memq
(eq? (memq 'a '()) #f)
(let ((x '(a b c c b a)))
(and (eq? (memq 'a x) x)
(eq? (memq 'b x) (cdr x))
(eq? (memq 'c x) (cddr x))
(eq? (memq 'd x) #f)))
(let ((x '(1 1/2 .5 (a . b))))
(and (eq? (memq 1 x) x)
(eq? (memq 1/2 x) #f)
(eq? (memq .5 x) #f)
(eq? (memq (cons 'a 'b) x) #f)
(eq? (memq .7 x) #f)))
(let* ((x (list 'a)) (y (list '(a) x 'b x)))
(eq? (memq x y) (cdr y)))
(let ((x (list (string #\h #\i) (string #\i #\h))))
(and (eq? (memq "hi" x) #f) (eq? (memq "ih" x) #f)))
(let ((x (list (list 'a) (list 'b) (list 'c) (list 'a))))
(and (eq? (memq '(a) x) #f)
(eq? (memq '(b) x) #f)
(eq? (memq '(c) x) #f)
(eq? (memq '(d) x) #f)))
(eq? (memq 'a cyclic-list) cyclic-list)
(eq? (memq 'b cyclic-list) (cdr cyclic-list))
(let ([x `(c d . ,cyclic-list)])
(eq? (memq 'd x) (cdr x)))
(let ([x '(a b . c)])
(and (eq? (memq 'a x) x) (eq? (memq 'b x) (cdr x))))
(error? (memq))
(error? (memq 'c))
(error? (memq 'c 'a))
(error? (memq 'c cyclic-list))
(error? (memq 'c '(a b . c)))
)
(mat memv
(eq? (memv 'a '()) #f)
(let ((x '(a b c c b a)))
(and (eq? (memv 'a x) x)
(eq? (memv 'b x) (cdr x))
(eq? (memv 'c x) (cddr x))
(eq? (memv 'd x) #f)))
(let ((x '(1 1/2 .5 12314122441)))
(and (eq? (memv 1 x) x)
(eq? (memv 1/2 x) (cdr x))
(eq? (memv .5 x) (cddr x))
(eq? (memv 12314122441 x) (cdddr x))
(eq? (memv .7 x) #f)))
(let* ((x (list 'a)) (y (list '(a) x 'b x)))
(eq? (memv x y) (cdr y)))
(let ((x (list (string #\h #\i) (string #\i #\h))))
(and (eq? (memv "hi" x) #f) (eq? (memv "ih" x) #f)))
(let ((x (list (list 'a) (list 'b) (list 'c) (list 'a))))
(and (eq? (memv '(a) x) #f)
(eq? (memv '(b) x) #f)
(eq? (memv '(c) x) #f)
(eq? (memv '(d) x) #f)))
(eq? (memv 'a cyclic-list) cyclic-list)
(eq? (memv 'b cyclic-list) (cdr cyclic-list))
(let ([x `(c d . ,cyclic-list)])
(eq? (memv 'd x) (cdr x)))
(let ([x '(a b . c)])
(and (eq? (memv 'a x) x) (eq? (member 'b x) (cdr x))))
(error? (memv))
(error? (memv 'c))
(error? (memv 'c 'a))
(error? (memv 'c cyclic-list))
(error? (memv 'c '(a b . c)))
(eq?
(memv 2 '#0=(1 2 3 . #0#))
(cdr '#0#))
)
(mat member
(eq? (member 'a '()) #f)
(let ((x '(a b c c b a)))
(and (eq? (member 'a x) x)
(eq? (member 'b x) (cdr x))
(eq? (member 'c x) (cddr x))
(eq? (member 'd x) #f)))
(let ((x '(1 1/2 .5 12314122441)))
(and (eq? (member 1 x) x)
(eq? (member 1/2 x) (cdr x))
(eq? (member .5 x) (cddr x))
(eq? (member 12314122441 x) (cdddr x))
(eq? (member .7 x) #f)))
(let* ((x (list 'a)) (y (list '(a) x 'b x)))
(eq? (member x y) y))
(let ((x (list 'hi (string #\h #\i) (string #\i #\h))))
(and (eq? (member "hi" x) (cdr x))
(eq? (member "ih" x) (cddr x))))
(let ((x '("hi" "ih" "hi")))
(and (eq? (member "hi" x) x) (eq? (member "ih" x) (cdr x))))
(let ((x (list (list 'a) (list 'b) (list 'c) (list 'a))))
(and (eq? (member '(a) x) x)
(eq? (member '(b) x) (cdr x))
(eq? (member '(c) x) (cddr x))
(eq? (member '(d) x) #f)))
(eq? (member 'a cyclic-list) cyclic-list)
(eq? (member 'b cyclic-list) (cdr cyclic-list))
(let ([x `(c d . ,cyclic-list)])
(eq? (member 'd x) (cdr x)))
(let ([x '(a b . c)])
(and (eq? (member 'a x) x) (eq? (member 'b x) (cdr x))))
(error? (member))
(error? (member 'c))
(error? (member 'c 'a))
(error? (member 'c cyclic-list))
(error? (member 'c '(a b . c)))
)
(mat partition
(equal?
(let-values ([x (partition negative? '())]) x)
'(() ()))
(let ((x (list -1 2 -3 -3 1 -5 2 6)))
(define-syntax valequal?
(syntax-rules ()
[(_ e v ...)
(let-values ([ls e]) (equal? ls (list v ...)))]))
(and (valequal? (partition pair? x) '() '(-1 2 -3 -3 1 -5 2 6))
(valequal? (partition negative? x) '(-1 -3 -3 -5) '(2 1 2 6))
(equal? x '(-1 2 -3 -3 1 -5 2 6))))
(error? ; improper list
(partition values cyclic-list))
(error? ; improper list
(partition values (cons 'x cyclic-list)))
(error? ; improper list
(partition values 'q))
(error? ; not a procedure
(partition 'q '()))
(eqv?
(let loop ([n 100])
(when (>= n 0)
(let ([ls (map (lambda (x) (random 20)) (make-list n))])
(let-values ([(odds evens) (partition odd? ls)])
(let-values ([(evens1 odds1) (partition even? ls)])
(unless (and (equal? odds1 odds) (equal? evens1 evens))
(printf "partition error 1: ~s\n" ls)
(errorf #f "partition test 1 failed")))
(let ([odds2 (filter odd? ls)] [evens2 (remp odd? ls)])
(unless (and (equal? odds2 odds) (equal? evens2 evens))
(printf "partition error 2: ~s\n" ls)
(errorf #f "partition test 2 failed")))
(let ([odds3 (remp even? ls)] [evens3 (filter even? ls)])
(unless (and (equal? odds3 odds) (equal? evens3 evens))
(printf "partition error 3: ~s\n" ls)
(errorf #f "partition test 3 failed")))
(let ([odds4 (fold-right (lambda (x ls) (if (odd? x) (cons x ls) ls)) '() ls)]
[evens4 (fold-right (lambda (x ls) (if (odd? x) ls (cons x ls))) '() ls)])
(unless (and (equal? odds4 odds) (equal? evens4 evens))
(printf "partition error 4: ~s\n" ls)
(errorf #f "partition test 4 failed")))
(let ([odds5 (reverse (fold-left (lambda (ls x) (if (odd? x) (cons x ls) ls)) '() ls))]
[evens5 (reverse (fold-left (lambda (ls x) (if (odd? x) ls (cons x ls))) '() ls))])
(unless (and (equal? odds5 odds) (equal? evens5 evens))
(printf "partition error 5: ~s\n" ls)
(errorf #f "partition test 5 failed")))))
(loop (- n 1))))
(void))
)
(mat filter
(equal?
(let ([x 3])
(let ([y (filter (begin (set! x 55) (lambda (x) #f)) '())])
(list x y)))
'(55 ()))
(equal?
(let ([x 3])
(let ([y (filter (begin (set! x (+ x 35)) (lambda (x) #f))
(begin (set! x (+ x 7)) '()))])
(list x y)))
'(45 ()))
(eq? (filter negative? '()) '())
(let ((x (list -1 2 -3 -3 1 -5 2 6)))
(and (equal? (filter pair? x) '())
(equal? (filter negative? x) '(-1 -3 -3 -5))
(equal? x '(-1 2 -3 -3 1 -5 2 6))))
(error? ; improper list
(filter values cyclic-list))
(error? ; improper list
(filter values (cons 'x cyclic-list)))
(error? ; improper list
(filter values 'q))
(error? ; not a procedure
(filter 'q '()))
)
(mat remp
(eqv? (remp (lambda (x) #t) '()) '())
(equal?
(let ([x 3])
(let ([y (remp (begin (set! x 55) (lambda (x) #t)) '())])
(list x y)))
'(55 ()))
(equal?
(let ([x 3])
(let ([y (remp (begin (set! x (+ x 35)) (lambda (x) #t))
(begin (set! x (+ x 7)) '()))])
(list x y)))
'(45 ()))
(let ([x (list 1 -2 3)])
(and (equal? (remp negative? x) '(1 3))
(equal? x '(1 -2 3))))
(let ([x (list 1 -2 3)])
(and (equal? (remp positive? x) '(-2))
(equal? x '(1 -2 3))))
(error? ; improper list
(remp values cyclic-list))
(error? ; improper list
(remp values (cons 'x cyclic-list)))
(error? ; improper list
(remp values 'q))
(error? ; not a procedure
(remp 'q '()))
)
(mat remq
(eq? (remq 'a '()) '())
(eq? (remq 'a '(a)) '())
(equal? (remq 'a '(b c)) '(b c))
(let* ((x (string #\a #\b)) (l (list 'a x "ab" 'c x "ab")))
(equal? (remq x l) '(a "ab" c "ab")))
(let* ((x (list 3)) (l (list 'a 'b x 'c '(3) 'd x 'e x)))
(equal? (remq x l) '(a b c (3) d e)))
(error? (remq "c" cyclic-list))
(error? (let ((s "c")) (remq "c" (cons s cyclic-list))))
(error? (remq "c" 'a))
)
(mat remq!
(eq? (remq! 'a '()) '())
(eq? (remq! 'a '(a)) '())
(equal? (remq! 'a '(b c)) '(b c))
(let* ((x (string #\a #\b)) (l (list 'a x "ab" 'c x "ab")))
(equal? (remq! x l) '(a "ab" c "ab")))
(let* ((x (list 3)) (l (list 'a 'b x 'c '(3) 'd x 'e x)))
(equal? (remq! x l) '(a b c (3) d e)))
(let* ((p1 (list 'a 'b 'c)) (p3 (cddr p1)))
(let* ((r1 (remq! 'b p1)) (r2 (cdr r1)))
(and (eq? p1 r1) (eq? r2 p3) (equal? p1 '(a c)))))
(error? (remq! "c" 'a))
(error? (remq! "c" (make-cyclic-list)))
)
(mat remv
(eq? (remv 'a '()) '())
(eq? (remv 'a '(a)) '())
(equal? (remv 'a '(b c)) '(b c))
(let* ((x (string #\a #\b)) (l (list 'a x "ab" 'c x "ab")))
(equal? (remv x l) '(a "ab" c "ab")))
(let* ((x (list 3)) (l (list 'a 'b x 'c '(3) 'd x 'e x)))
(equal? (remv x l) '(a b c (3) d e)))
(error? (remv "c" cyclic-list))
(error? (let ((s "c")) (remv "c" (cons s cyclic-list))))
(error? (remv "c" 'a))
)
(mat remv!
(eq? (remv! 'a '()) '())
(eq? (remv! 'a '(a)) '())
(equal? (remv! 'a '(b c)) '(b c))
(let* ((x (string #\a #\b)) (l (list 'a x "ab" 'c x "ab")))
(equal? (remv! x l) '(a "ab" c "ab")))
(let* ((x (list 3)) (l (list 'a 'b x 'c '(3) 'd x 'e x)))
(equal? (remv! x l) '(a b c (3) d e)))
(let* ((p1 (list 'a 'b 'c)) (p3 (cddr p1)))
(let* ((r1 (remv! 'b p1)) (r2 (cdr r1)))
(and (eq? r1 p1) (eq? r2 p3) (equal? p1 '(a c)))))
(error? (remv! "c" (make-cyclic-list)))
(error? (remv! "c" 'a))
)
(mat remove
(eq? (remove 'a '()) '())
(eq? (remove 'a '(a)) '())
(equal? (remove 'a '(b c)) '(b c))
(let* ((x (string #\a #\b)) (l (list 'a x "ab" 'c x "ab")))
(equal? (remove x l) '(a c)))
(let* ((x (list 3)) (l (list 'a 'b x 'c '(3) 'd x 'e x)))
(equal? (remove x l) '(a b c d e)))
(error? (remove "c" cyclic-list))
(error? (let ((s "c")) (remove "c" (cons s cyclic-list))))
(error? (remove "c" 'a))
)
(mat remove!
(eq? (remove! 'a '()) '())
(eq? (remove! 'a '(a)) '())
(equal? (remove! 'a '(b c)) '(b c))
(let* ((x (string #\a #\b)) (l (list 'a x "ab" 'c x "ab")))
(equal? (remove! x l) '(a c)))
(let* ((x (list 3)) (l (list 'a 'b x 'c '(3) 'd x 'e x)))
(equal? (remove! x l) '(a b c d e)))
(let* ((p1 (list 'a 'b 'c)) (p3 (cddr p1)))
(let* ((r1 (remove! 'b p1)) (r2 (cdr r1)))
(and (eq? r1 p1) (eq? r2 p3) (equal? p1 '(a c)))))
(error? (remove! "c" (make-cyclic-list)))
)
(mat substq
(equal? (substq 1 'b '((b c) b a)) '((1 c) 1 a))
(equal? (substq 1 'd '((b c) b a)) '((b c) b a))
(equal? (substq 1/3 1/2 '((1/2 c) 1/2 a)) '((1/2 c) 1/2 a))
(let* ([x (cons 'a 'b)] [y (cons (cons 'a 'b) x)])
(equal? (substq 'boo x y) '((a . b) . boo)))
(let ((x '((b c) b a)))
(eq? x (substq 1 'd x)))
)
(mat substq!
(equal? (substq! 1 'b '((b c) b a)) '((1 c) 1 a))
(equal? (substq! 1 'd '((b c) b a)) '((b c) b a))
(equal? (substq! 1/3 1/2 '((1/2 c) 1/2 a)) '((1/2 c) 1/2 a))
(let* ([x (cons 'a 'b)] [y (cons (cons 'a 'b) x)])
(equal? (substq! 'boo x y) '((a . b) . boo)))
(let ((x '((b c) b a)))
(eq? x (substq! 1 'd x)))
(let ((x '((b c) b a)))
(eq? x (substq! 1 'b x)))
)
(mat substv
(equal? (substv 1 'b '((b c) b a)) '((1 c) 1 a))
(equal? (substv 1 'd '((b c) b a)) '((b c) b a))
(equal? (substv 1/3 1/2 '((1/2 c) 1/2 a)) '((1/3 c) 1/3 a))
(let* ([x (cons 'a 'b)] [y (cons (cons 'a 'b) x)])
(equal? (substv 'boo x y) '((a . b) . boo)))
(let ((x '((b c) b a)))
(eq? x (substv 1 'd x)))
)
(mat substv!
(equal? (substv! 1 'b '((b c) b a)) '((1 c) 1 a))
(equal? (substv! 1 'd '((b c) b a)) '((b c) b a))
(equal? (substv! 1/3 1/2 '((1/2 c) 1/2 a)) '((1/3 c) 1/3 a))
(let* ([x (cons 'a 'b)] [y (cons (cons 'a 'b) x)])
(equal? (substv! 'boo x y) '((a . b) . boo)))
(let ((x '((b c) b a)))
(eq? x (substv! 1 'd x)))
(let ((x '((b c) b a)))
(eq? x (substv! 1 'b x)))
)
(mat subst
(equal? (subst 1 'b '((b c) b a)) '((1 c) 1 a))
(equal? (subst 1 'd '((b c) b a)) '((b c) b a))
(equal? (subst 1/3 1/2 '((1/2 c) 1/2 a)) '((1/3 c) 1/3 a))
(let* ([x (cons 'a 'b)] [y (cons (cons 'a 'b) x)])
(equal? (subst 'boo x y) '(boo . boo)))
(let ((x '((b c) b a)))
(eq? x (subst 1 'd x)))
)
(mat subst!
(equal? (subst! 1 'b '((b c) b a)) '((1 c) 1 a))
(equal? (subst! 1 'd '((b c) b a)) '((b c) b a))
(equal? (subst! 1/3 1/2 '((1/2 c) 1/2 a)) '((1/3 c) 1/3 a))
(let* ([x (cons 'a 'b)] [y (cons (cons 'a 'b) x)])
(equal? (subst! 'boo x y) '(boo . boo)))
(let ((x '((b c) b a)))
(eq? x (subst! 1 'd x)))
(let ((x '((b c) b a)))
(eq? x (subst! 1 'b x)))
)
(mat assp
(not (assp (lambda (x) #t) '()))
(let ([a (list -1)] [b (list 2)] [c (list 3)])
(let ([l (list a b c)])
(and (equal? (assp negative? l) a)
(equal? (assp positive? l) b)
(equal? (assp (lambda (x) (= x 3)) l) c)
(not (assp pair? l)))))
(eq? (cdr (assp (lambda (x) (eq? x 'a)) cyclic-alist)) 1)
(eq? (cdr (assp (lambda (x) (eq? x 'a)) (cdr cyclic-alist))) 1)
(eq? (cdr (assp (lambda (x) (eqv? x 3.2)) cyclic-alist)) 3)
(eq? (cdr (assp (lambda (x) (equal? x "a")) cyclic-alist)) 4)
(error? ; cyclic alist
(assp (lambda (x) #f) cyclic-alist))
(error? ; improper alist
(assp (lambda (x) #f) '((a . 1) . c)))
(error? ; improper alist
(assp (lambda (x) #f) 17))
(error? ; not a procedure
(assp 'a '((a . 1) (b . 2))))
)
(mat assq
(eq? (assq 'a '()) #f)
(let ((a (list 'a)) (b (list 'b)) (c (list 'c)))
(let ((l (list a b '(c) c b a)))
(and (eq? (assq 'a l) a)
(eq? (assq 'b l) b)
(not (eq? (assq 'c l) c))
(eq? (assq 'd l) #f))))
(let* ((x (list 'a)) (l `(((a)) ((b)) (,x) ((c)))))
(eq? (assq x l) (caddr l)))
(eq? (cdr (assq 'a cyclic-alist)) 1)
(error? (assq 3.2 cyclic-alist))
(error? (assq "a" cyclic-alist))
(error? (assq 'c cyclic-alist))
(error? (assq "s" cyclic-alist))
)
(mat assv
(eq? (assv 'a '()) #f)
(let ((a (list 'a)) (b (list 'b)) (c (list 'c)))
(let ((l (list a b '(c) c b a)))
(and (eq? (assv 'a l) a)
(eq? (assv 'b l) b)
(not (eq? (assv 'c l) c))
(eq? (assv 'd l) #f))))
(let* ((x (list 'a)) (l `(((a)) ((b)) (,x) ((c)))))
(eq? (assv x l) (caddr l)))
(eq? (cdr (assv 'a cyclic-alist)) 1)
(eq? (cdr (assv 3.2 cyclic-alist)) 3)
(error? (assv "a" cyclic-alist))
(error? (assv 1/2 cyclic-alist))
(error? (assv "s" cyclic-alist))
)
(mat assoc
(eq? (assoc 'a '()) #f)
(let ((a (list 'a)) (b (list 'b)) (c (list 'c)))
(let ((l (list a b '(c) c b a)))
(and (eq? (assoc 'a l) a)
(eq? (assoc 'b l) b)
(not (eq? (assoc 'c l) c))
(eq? (assoc 'd l) #f))))
(let* ((x (list 'a)) (l `(((a)) ((b)) (,x) ((c)))))
(eq? (assoc x l) (car l)))
(eq? (cdr (assoc 'a cyclic-alist)) 1)
(eq? (cdr (assoc 3.2 cyclic-alist)) 3)
(eq? (cdr (assoc "a" cyclic-alist)) 4)
(error? (assoc 1/2 cyclic-alist))
(error? (assoc "s" cyclic-alist))
)
(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 sort
(error? ; invalid number of arguments
(sort))
(error? ; invalid number of arguments
(sort >))
(error? ; invalid number of arguments
(sort '(a b c)))
(error? ; invalid number of arguments
(sort > '(1 2 3) #t))
(error? ; 3 is not a proper list
(sort > 3))
(error? ; #(1 2 3) is not a proper list
(sort > '#(1 2 3)))
(error? ; (1 2 . 3) is not a proper list
(sort > '(1 2 . 3)))
(error? ; cyclic list
(sort (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
cyclic-list))
(error? ; cyclic list
(sort (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(cdr cyclic-list)))
(error? ; cyclic list
(sort (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
`(q p . ,cyclic-list)))
(error? ; (a b c) is not a procedure
(sort '(a b c) '(a b c)))
(error? ; b is not a real number
(sort > '(1 b 3)))
(equal? (sort > '()) '())
(let ([v (list 3 2 1)])
(and
(equal? (sort > v) '(3 2 1))
(equal? v '(3 2 1))))
(let ([v (list 1 2 3)])
(and
(equal? (sort > v) '(3 2 1))
(equal? v '(1 2 3))))
(let ([v (list 2 3 1)])
(and
(equal? (sort > v) '(3 2 1))
(equal? v '(2 3 1))))
(let ([v (list -2 3.0 9 8 3 -11 0 9 -5 -7 -43 8.0 5)])
(and
(equal?
(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 (list 2 5 8 -3 9 10 -5 8 -8 4 2 3 1 -1 -9)])
(and
(equal?
(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 (list 1 3 2 4)])
(and
(equal? (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))]
[copy (map values ls)])
(unless (and
(equal? (sort < ls) ($merge-sort < copy))
(equal? ls copy))
(fprintf (console-output-port) "\n~s\n" ls)
(errorf #f "failed")))))))
(make-string 200 #\.))
)
(mat list-sort
(error? ; invalid number of arguments
(list-sort))
(error? ; invalid number of arguments
(list-sort >))
(error? ; invalid number of arguments
(list-sort '(a b c)))
(error? ; invalid number of arguments
(list-sort > '(1 2 3) #t))
(error? ; 3 is not a proper list
(list-sort > 3))
(error? ; #(1 2 3) is not a proper list
(list-sort > '#(1 2 3)))
(error? ; (1 2 . 3) is not a proper list
(list-sort > '(1 2 . 3)))
(error? ; cyclic list
(list-sort (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
cyclic-list))
(error? ; cyclic list
(list-sort (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(cdr cyclic-list)))
(error? ; cyclic list
(list-sort (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
`(q p . ,cyclic-list)))
(error? ; (a b c) is not a procedure
(list-sort '(a b c) '(a b c)))
(error? ; b is not a real number
(list-sort > '(1 b 3)))
(equal? (list-sort > '()) '())
(let ([v (list 3 2 1)])
(and
(equal? (list-sort > v) '(3 2 1))
(equal? v '(3 2 1))))
(let ([v (list 1 2 3)])
(and
(equal? (list-sort > v) '(3 2 1))
(equal? v '(1 2 3))))
(let ([v (list 2 3 1)])
(and
(equal? (list-sort > v) '(3 2 1))
(equal? v '(2 3 1))))
(let ([v (list -2 3.0 9 8 3 -11 0 9 -5 -7 -43 8.0 5)])
(and
(equal?
(list-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 (list 2 5 8 -3 9 10 -5 8 -8 4 2 3 1 -1 -9)])
(and
(equal?
(list-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 (list 1 3 2 4)])
(and
(equal? (list-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))]
[copy (map values ls)])
(unless (and
(equal? (list-sort < ls) ($merge-sort < copy))
(equal? ls copy))
(fprintf (console-output-port) "\n~s\n" ls)
(errorf #f "failed")))))))
(make-string 200 #\.))
)
(mat sort!
(error? ; invalid number of arguments
(sort!))
(error? ; invalid number of arguments
(sort! >))
(error? ; invalid number of arguments
(sort! '(a b c)))
(error? ; invalid number of arguments
(sort! > '(1 2 3) #t))
(error? ; 3 is not a proper list
(sort! > 3))
(error? ; #(1 2 3) is not a proper list
(sort! > '#(1 2 3)))
(error? ; (1 2 . 3) is not a proper list
(sort! > (cons* 1 2 3)))
(error? ; cyclic list
(sort! (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(make-cyclic-list)))
(error? ; cyclic list
(sort! (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(cdr (make-cyclic-list))))
(error? ; cyclic list
(sort! (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
`(q p . ,(make-cyclic-list))))
(error? ; (a b c) is not a procedure
(sort! '(a b c) '(a b c)))
(error? ; b is not a real number
(sort! > '(1 b 3)))
(equal? (sort! > '()) '())
(let ([v (list 3 2 1)])
(equal? (sort! > v) '(3 2 1)))
(let ([v (list 1 2 3)])
(equal? (sort! > v) '(3 2 1)))
(let ([v (list 2 3 1)])
(equal? (sort! > v) '(3 2 1)))
(let ([v (list -2 3.0 9 8 3 -11 0 9 -5 -7 -43 8.0 5)])
(equal?
(sort! < v)
'(-43 -11 -7 -5 -2 0 3.0 3 5 8 8.0 9 9)))
(let ([v (list 2 5 8 -3 9 10 -5 8 -8 4 2 3 1 -1 -9)])
(equal?
(sort! (lambda (x y) (< (abs x) (abs y))) v)
'(1 -1 2 2 -3 3 4 5 -5 8 8 -8 9 -9 10)))
(let ([v (list 1 3 2 4)])
(equal? (sort! < 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))]
[copy (map values ls)])
(unless (equal? (sort! < ls) ($merge-sort < copy))
(fprintf (console-output-port) "\n~s\n" copy)
(errorf #f "failed")))))))
(make-string 200 #\.))
)
(mat merge
(equal? (merge < '() '()) '())
(equal? (merge < '(1) '()) '(1))
(equal? (merge < '() '(2)) '(2))
(equal? (merge < '(1) '(2)) '(1 2))
(equal? (merge < '(2) '(1)) '(1 2))
(equal? (merge < '(1 3 5 7 9) '(2 4 6 8 10)) '(1 2 3 4 5 6 7 8 9 10))
(equal? (merge < '(1 2 5 7 8) '(3 4 6 9 10)) '(1 2 3 4 5 6 7 8 9 10))
(equal?
(merge (lambda (x y) (< (abs x) (abs y)))
'(-1 1 4 -4)
'(1 -3 3 8 9 -9))
'(-1 1 1 -3 3 4 -4 8 9 -9))
(let ((l1 (list 1 3 5 7 9)) (l2 (list 2 4 6 8 10)))
(and (equal? (merge < l1 l2) '(1 2 3 4 5 6 7 8 9 10))
(equal? l1 '(1 3 5 7 9))
(equal? l2 '(2 4 6 8 10))))
(error? ; (1 2 . 3) is not a proper list
(merge > '(5 -1 2) '(1 2 . 3)))
(error? ; (1 2 . 3) is not a proper list
(merge > '(1 2 . 3) '(5 -1 2)))
(error? ; cyclic list
(merge (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
'(p b q) cyclic-list))
(error? ; cyclic list
(merge (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
cyclic-list '(p b q)))
(error? ; cyclic list
(merge (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
'(p b c) (cdr cyclic-list)))
(error? ; cyclic list
(merge (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(cdr cyclic-list) '(p b c)))
(error? ; cyclic list
(merge (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
'(p b c) `(q p . ,cyclic-list)))
(error? ; cyclic list
(merge (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
`(q p . ,cyclic-list) '(p b c)))
)
(mat merge!
(equal? (merge! < '() '()) '())
(equal? (merge! < '(1) '()) '(1))
(equal? (merge! < '() '(2)) '(2))
(equal? (merge! < '(1) '(2)) '(1 2))
(equal? (merge! < '(2) '(1)) '(1 2))
(equal? (merge! < '(1 3 5 7 9) '(2 4 6 8 10)) '(1 2 3 4 5 6 7 8 9 10))
(equal? (merge! < '(1 2 5 7 8) '(3 4 6 9 10)) '(1 2 3 4 5 6 7 8 9 10))
(equal?
(merge! (lambda (x y) (< (abs x) (abs y)))
'(-1 1 4 -4)
'(1 -3 3 8 9 -9))
'(-1 1 1 -3 3 4 -4 8 9 -9))
(error? ; (1 2 . 3) is not a proper list
(merge! > (list 5 -1 2) (cons* 1 2 3)))
(error? ; (1 2 . 3) is not a proper list
(merge! > (cons* 1 2 3) (list 5 -1 2)))
(error? ; cyclic list
(merge! (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(list 'p 'b 'q) (make-cyclic-list)))
(error? ; cyclic list
(merge! (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(make-cyclic-list) (list 'p 'b 'q)))
(error? ; cyclic list
(merge! (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(list 'p 'b 'q) (cdr (make-cyclic-list))))
(error? ; cyclic list
(merge! (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(cdr (make-cyclic-list)) (list 'p 'b 'q)))
(error? ; cyclic list
(merge! (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(list 'p 'b 'q) (cons* 'q 'p (make-cyclic-list))))
(error? ; cyclic list
(merge! (lambda (x y) (string<? (symbol->string x) (symbol->string y)))
(cons* 'q 'p (make-cyclic-list)) (list 'p 'b 'q)))
)
(mat iota
(error? ; not a nonnegative fixnum
(iota 'a))
(error? ; not a nonnegative fixnum
(iota -1))
(error? ; not a nonnegative fixnum
(iota #e1e30))
(error? ; not a nonnegative fixnum
(iota 3/4))
(error? ; wrong number of arguments
(iota))
(error? ; wrong number of arguments
(iota 3 17))
(equal? (iota 7) '(0 1 2 3 4 5 6))
(equal? (iota 6) '(0 1 2 3 4 5))
(equal? (iota 0) '())
(equal? (iota 1) '(0))
(equal? (iota 2) '(0 1))
(equal? (iota 3) '(0 1 2))
(equal? (iota 4) '(0 1 2 3))
(let ([ls (iota 100)])
(and
(= (length ls) 100)
(equal? ls (sort < ls))
(eqv? (car ls) 0)
(eqv? (apply + ls) 4950)))
)
(mat enumerate
(error? ; not a proper list
(enumerate 'a))
(error? ; not a proper list
(enumerate '(a . b)))
(error? ; not a proper list
(enumerate (let ([ls (list 'a 'b 'c)]) (set-cdr! (cdr ls) ls) ls)))
(error? ; wrong number of arguments
(enumerate))
(error? ; wrong number of arguments
(enumerate '(a b c) '(d e f)))
(equal? (enumerate '(a b c d e f g)) '(0 1 2 3 4 5 6))
(equal? (enumerate '(a b c d e f)) '(0 1 2 3 4 5))
(equal? (enumerate '()) '())
(equal? (enumerate '(1)) '(0))
(equal? (enumerate '(3 2)) '(0 1))
(equal? (enumerate '(5 4 3)) '(0 1 2))
(equal? (enumerate '(q p (d o l) l)) '(0 1 2 3))
(let ([ls (enumerate (make-list 100))])
(and
(= (length ls) 100)
(equal? ls (sort < ls))
(eqv? (car ls) 0)
(eqv? (apply + ls) 4950)))
)