2d4f3e2ac9
The layer is now redundant, since everything left in "pkgs" is in the "racket-pkgs" category.
661 lines
23 KiB
Racket
661 lines
23 KiB
Racket
(module other-tests mzscheme
|
|
(require mzlib/match rackunit)
|
|
|
|
(provide other-tests)
|
|
|
|
(define-syntax (mytest stx)
|
|
(syntax-case stx ()
|
|
[(mytest tst exp)
|
|
#`(test-case (format "test: ~a" (syntax-object->datum (quote-syntax tst)))
|
|
#,(syntax/loc stx (check-equal? tst exp)))]))
|
|
|
|
(define-syntax mytest-no-order
|
|
(syntax-rules ()
|
|
[(mytest tst exp)
|
|
(test-case (format "no-order test: ~a" (syntax-object->datum (quote-syntax tst)))
|
|
(check set-equal? tst exp))]))
|
|
|
|
(define other-tests
|
|
(test-suite "Tests copied from match-test.rkt"
|
|
|
|
(mytest (letrec ((z
|
|
(lambda (x)
|
|
(match x
|
|
((a b c)
|
|
(if (= a 10)
|
|
(list a b c)
|
|
(begin (cons a (z (list (add1 a) 2 3))))))))))
|
|
(z '(1 2 3)))
|
|
'(1 2 3 4 5 6 7 8 9 10 2 3))
|
|
|
|
; this is the same test for match-lambda
|
|
|
|
(mytest (letrec ((z (match-lambda ((a b c)
|
|
(if (= a 10)
|
|
(list a b c)
|
|
(cons a (z (list (add1 a) 2 3))))))))
|
|
(z '(1 2 3)))
|
|
'(1 2 3 4 5 6 7 8 9 10 2 3))
|
|
|
|
(mytest (letrec ((z (match-lambda* ((a b c)
|
|
(if (= a 10)
|
|
(list a b c)
|
|
(cons a (z (add1 a) 2 3)))))))
|
|
(z 1 2 3))
|
|
'(1 2 3 4 5 6 7 8 9 10 2 3))
|
|
; matchlet tests
|
|
|
|
(mytest (match-let (((a b c) '(1 2 3))
|
|
((d e f) '(4 5 6)))
|
|
(list a b c d e f))
|
|
'(1 2 3 4 5 6))
|
|
|
|
|
|
; match: syntax error in (match (hey (((a b c) (d e f)) (list a b c d e f))))
|
|
(mytest (match-let hey (((a b c) '(1 2 3))
|
|
((d e f) '(4 5 6)))
|
|
(list a b c d e f))
|
|
'(1 2 3 4 5 6))
|
|
|
|
(mytest (match-let hey (((a b c) '(1 2 3))
|
|
((d e f) '(4 5 6)))
|
|
(if (= a 10)
|
|
'()
|
|
(cons a (hey (list (add1 a) b c) '(d e f)))))
|
|
'(1 2 3 4 5 6 7 8 9))
|
|
|
|
(mytest (let ((f 7))
|
|
(match-let ([(a b c) (list 1 2 f)] [(d e) '(5 6)]) (list a d c f)))
|
|
'(1 5 7 7))
|
|
|
|
; match-let*
|
|
|
|
(mytest (match-let* (((a b c) '(1 2 3))
|
|
((d e f) '(4 5 6)))
|
|
(list a b c d e f))
|
|
'(1 2 3 4 5 6))
|
|
|
|
(mytest (match-let* ([(a b c) '(1 2 3)]
|
|
[(d e f) (list a b c)])
|
|
(list d e f)) ; should be (1 2 3)
|
|
'(1 2 3))
|
|
|
|
|
|
(mytest (let ((f 7))
|
|
(match-let* ([(a b c) (list 1 2 f)] [(d e) '(5 6)]) (list a d c f)))
|
|
'(1 5 7 7))
|
|
; match-letrec
|
|
|
|
;; let rec does not work this well on chez or plt
|
|
;(match-letrec ([(a b) (list (lambda (x) (if (zero? x) '() (cons x (a (sub1 x)))))
|
|
; (lambda (x) (if (= x 10) '() (cons x (b (add1 x))))))]
|
|
; [(c d) (list (a 10) (b 0))])
|
|
; (list c d))
|
|
|
|
(mytest (match-letrec (((a b c) '(1 2 3))
|
|
((d e f) '(4 5 6)))
|
|
(list a b c d e f))
|
|
'(1 2 3 4 5 6))
|
|
|
|
(mytest (match-letrec ([(a b) (list (lambda (x) (if (zero? x) '() (cons x (a (sub1 x)))))
|
|
(lambda (x) (if (= x 10) '() (cons x (b (add1 x))))))])
|
|
(a 10))
|
|
'(10 9 8 7 6 5 4 3 2 1))
|
|
|
|
(mytest (match-letrec ([(a b) (list (lambda (x) (if (zero? x) '() (cons (b x) (a (sub1 x)))))
|
|
(lambda (x) (if (= x 10) '() (cons x (b (add1 x))))))])
|
|
(a 10))
|
|
'(() (9) (8 9) (7 8 9) (6 7 8 9) (5 6 7 8 9) (4 5 6 7 8 9)
|
|
(3 4 5 6 7 8 9) (2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9)))
|
|
|
|
|
|
(mytest (let ((f 7))
|
|
(match-letrec ([(a b c) (list 1 2 f)] [(d e) '(5 6)]) (list a d c f)))
|
|
'(1 5 7 7))
|
|
|
|
|
|
; match-lambda
|
|
|
|
|
|
(mytest (let ((f 7))
|
|
((match-lambda ((a b) (list a b f))) '(4 5)))
|
|
'(4 5 7))
|
|
|
|
(mytest (let ((f 7))
|
|
((match-lambda* ((a b) (list a b f))) 4 5))
|
|
'(4 5 7))
|
|
|
|
; match-define
|
|
|
|
(mytest (let ((f 7))
|
|
(match-define (a b c) (list 1 2 f))
|
|
(list a b c f))
|
|
'(1 2 7 7))
|
|
|
|
|
|
(test-case "match-define"
|
|
(let () (match-define (a b) (list (lambda (x) (if (zero? x) '() (cons (b x) (a (sub1 x)))))
|
|
(lambda (x) (if (= x 10) '() (cons x (b (add1 x)))))))
|
|
(check-equal? (a 10)
|
|
'(() (9) (8 9) (7 8 9) (6 7 8 9) (5 6 7 8 9) (4 5 6 7 8 9)
|
|
(3 4 5 6 7 8 9) (2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9)))))
|
|
|
|
|
|
; this is some thing that I missed before
|
|
|
|
(mytest (match '((1) (2) (3)) (((_) ...) 'hey))
|
|
'hey)
|
|
|
|
; failure tests
|
|
|
|
(mytest (match '(1 2 3)
|
|
((a b c) (=> fail) (if (= a 1) (fail) 'bad))
|
|
((a b c) (=> fail) (if (= a 1) (fail) 'bad))
|
|
((a b c) (=> fail) (if (= a 1) (fail) 'bad))
|
|
((a b c) (=> fail) (if (= a 1) (fail) 'bad))
|
|
((a b c) (=> fail) (if (= a 1) (fail) 'bad))
|
|
((a b c) (=> fail) (if (= a 1) (fail) 'bad))
|
|
((a b c) (list a b c)))
|
|
'(1 2 3))
|
|
|
|
; (mytest (match '(1 2 3)
|
|
; ((a b c) (=> fail) (if (= a 1) (fail) 'bad)))
|
|
; '()) ; this should through a different exception
|
|
|
|
|
|
|
|
; set! tests
|
|
|
|
; set! for lists
|
|
#|
|
|
(mytest (let ((x '(1 2 (3 4))))
|
|
(match x
|
|
((_ _ ((set! set-it) _)) (set-it 17)))
|
|
x)
|
|
'(1 2 (17 4)))
|
|
|
|
(mytest (let ((x '(1 2 (3 4))))
|
|
(match x
|
|
((_ _ (_ (set! set-it))) (set-it 17)))
|
|
x)
|
|
'(1 2 (3 17)))
|
|
|
|
(mytest (let ((x '(1 2 (3 4))))
|
|
(match x
|
|
(((set! set-it) _ (_ _)) (set-it 17)))
|
|
x)
|
|
'(17 2 (3 4)))
|
|
|
|
(mytest (let ((x '(1 2 (3 4))))
|
|
(match x
|
|
((_ (set! set-it) (_ _)) (set-it 17)))
|
|
x)
|
|
'(1 17 (3 4)))
|
|
|
|
;set! for improper lists
|
|
|
|
(mytest (let ((x '(1 2 (3 . 4) . 5)))
|
|
(match x
|
|
(((set! set-it) _ (_ . _) . _) (set-it 17)))
|
|
x)
|
|
'(17 2 (3 . 4) . 5))
|
|
|
|
(mytest (let ((x '(1 2 (3 . 4) . 5)))
|
|
(match x
|
|
((_ (set! set-it) (_ . _) . _) (set-it 17)))
|
|
x)
|
|
'(1 17 (3 . 4) . 5))
|
|
|
|
(mytest (let ((x '(1 2 (3 . 4) . 5)))
|
|
(match x
|
|
((_ _ ((set! set-it) . _) . _) (set-it 17)))
|
|
x)
|
|
'(1 2 (17 . 4) . 5))
|
|
|
|
(mytest (let ((x '(1 2 (3 . 4) . 5)))
|
|
(match x
|
|
((_ _ (_ . (set! set-it)) . _) (set-it 17)))
|
|
x)
|
|
'(1 2 (3 . 17) . 5))
|
|
|
|
(mytest (let ((x '(1 2 (3 . 4) . 5)))
|
|
(match x
|
|
((_ _ (_ . _) . (set! set-it)) (set-it 17)))
|
|
x)
|
|
'(1 2 (3 . 4) . 17))
|
|
|
|
;; set! for vectors
|
|
|
|
(mytest (let ((x (vector 1 2)))
|
|
(match x (#(_ (set! set-it)) (set-it 17)))
|
|
x)
|
|
#(1 17))
|
|
|
|
(mytest (let ((x (vector 1 2)))
|
|
(match x (#((set! set-it) _) (set-it 17)))
|
|
x)
|
|
#(17 2))
|
|
|
|
;; set! for boxes
|
|
|
|
(mytest (let ((x (box 1)))
|
|
(match x (#&(set! set-it) (set-it 17)))
|
|
x)
|
|
#&17)
|
|
#;
|
|
(mytest (let ((x #&(1 2)))
|
|
(match x (#&(_ (set! set-it)) (set-it 17)))
|
|
x)
|
|
#&(1 17))
|
|
|
|
(mytest (let ((x (box (vector 1 2))))
|
|
(match x (#&#(_ (set! set-it)) (set-it 17)))
|
|
x)
|
|
#&#(1 17))
|
|
|
|
|
|
; get! tests
|
|
|
|
; get! for lists
|
|
#|
|
|
(mytest (let* ((x '(1 2 (3 4)))
|
|
(f (match x ((_ _ ((get! get-it) _)) get-it))))
|
|
(match x ((_ _ ((set! set-it) _)) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
(mytest (let* ((x '(1 2 (3 4)))
|
|
(f (match x ((_ _ (_ (get! get-it))) get-it))))
|
|
(match x ((_ _ (_ (set! set-it))) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
(mytest (let* ((x '(1 2 (3 4)))
|
|
(f (match x (((get! get-it) _ (_ _)) get-it))))
|
|
(match x (((set! set-it) _ (_ _)) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
(mytest (let* ((x '(1 2 (3 4)))
|
|
(f (match x ((_ (get! get-it) (_ _)) get-it))))
|
|
(match x ((_ (set! set-it) (_ _)) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
|
|
;get! for improper lists
|
|
|
|
(mytest (let* ((x '(1 2 (3 . 4) . 5))
|
|
(f (match x (((get! get-it) _ (_ . _) . _) get-it))))
|
|
(match x (((set! set-it) _ (_ . _) . _) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
(mytest (let* ((x '(1 2 (3 . 4) . 5))
|
|
(f (match x ((_ (get! get-it) (_ . _) . _) get-it))))
|
|
(match x ((_ (set! set-it) (_ . _) . _) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
(mytest (let* ((x '(1 2 (3 . 4) . 5))
|
|
(f (match x ((_ _ ((get! get-it) . _) . _) get-it))))
|
|
(match x ((_ _ ((set! set-it) . _) . _) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
(mytest (let* ((x '(1 2 (3 . 4) . 5))
|
|
(f (match x ((_ _ (_ . (get! get-it)) . _) get-it))))
|
|
(match x ((_ _ (_ . (set! set-it)) . _) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
(mytest (let* ((x '(1 2 (3 . 4) . 5))
|
|
(f (match x ((_ _ (_ . _) . (get! get-it)) get-it))))
|
|
(match x ((_ _ (_ . _) . (set! set-it)) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
|#
|
|
;; get! for vectors
|
|
|
|
(mytest (let* ((x (vector 1 2))
|
|
(f (match x (#(_ (get! get-it)) get-it))))
|
|
(match x (#(_ (set! set-it)) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
(mytest (let* ((x (vector 1 2))
|
|
(f (match x (#((get! get-it) _) get-it))))
|
|
(match x (#((set! set-it) _) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
|
|
;; get! for boxes
|
|
|
|
(mytest (let* ((x (box 1))
|
|
(f (match x (#&(get! get-it) get-it))))
|
|
(match x (#&(set! set-it) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
#;
|
|
(mytest (let* ((x #&(1 2))
|
|
(f (match x (#&(_ (get! get-it)) get-it))))
|
|
(match x (#&(_ (set! set-it)) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
(mytest (let* ((x (box (vector 1 2)))
|
|
(f (match x (#&#(_ (get! get-it)) get-it))))
|
|
(match x (#&#(_ (set! set-it)) (set-it 17)))
|
|
(f))
|
|
17)
|
|
|
|
|
|
|#
|
|
;; quasi quote tests
|
|
|
|
|
|
(mytest (match '(1 2 3 4 . b)
|
|
(`(,b 2 ,@(3 4) . b) b))
|
|
1)
|
|
|
|
(mytest (match '(1 2 3 4 . 5)
|
|
(`(1 2 ,@(3 4) . ,b) b))
|
|
5)
|
|
|
|
(mytest (match '(a ()) (`(a ()) #t))
|
|
#t)
|
|
|
|
(mytest (match '(1 2 3)
|
|
(`(,a ,b ,c) (list a b c)))
|
|
'(1 2 3))
|
|
|
|
(mytest (match '(c a b 1 2 3 r f i)
|
|
(`(c a b ,@(a b c) r f i) (list a b c)))
|
|
'(1 2 3))
|
|
|
|
(mytest (match '(3 4 #\c a b 1 (2 (c d)))
|
|
(`(3 4 #\c a b ,a ,(b `(c e))) 'not-good)
|
|
(`(3 4 #\c a b ,a ,(b `(c d))) (list a b)))
|
|
'(1 2))
|
|
|
|
(mytest (match #(x 2 x)
|
|
(`#(x ,x x) (list x)))
|
|
'(2))
|
|
|
|
(mytest (match #(x 2 x) ;remember that the x's are symbols here
|
|
(`#(x ,x x) (list x)))
|
|
'(2))
|
|
|
|
(mytest (match #(c a b 1 2 3 r f i)
|
|
(`#(c a b ,@(a b c) r f i) (list a b c)))
|
|
'(1 2 3))
|
|
|
|
(mytest (match #&(c a b 1 2 3 r f i)
|
|
(`#&(c a b ,@(a b c) r f i) (list a b c)))
|
|
'(1 2 3))
|
|
|
|
(mytest (match (list "hi" 1 'there #\c #t #f '(a b c) '(a b . c)
|
|
'(a b c c c c) #(a b c) #(a b c c c c) #&(a b c)
|
|
'(1 2 3) '(4 5 . 6) '(7 8 9) #(10 11 12) #&(13 14 15 16)
|
|
1 2 3 4 17)
|
|
(`("hi" 1 there #\c #t #f (a b c) (a b . c) (a b c ..2) #(a b c)
|
|
#(a b c ..2) #&(a b c) ,(a b c) ,(c1 d . e) ,(f g h ...)
|
|
,#(i j k) ,#&(l m n o) ,@(1 2 3 4 p))
|
|
(list a b c c1 d e f g h i j k l m n o p)))
|
|
'(1 2 3 4 5 6 7 8 (9) 10 11 12 13 14 15 16 17))
|
|
|
|
(mytest (match (vector "hi" 1 'there #\c #t #f '(a b c) '(a b . c)
|
|
'(a b c c c c) #(a b c) #(a b c c c c) #&(a b c)
|
|
'(1 2 3) '(4 5 . 6) '(7 8 9) #(10 11 12)
|
|
#&(13 14 15 16) 1 2 3 4 17)
|
|
(`#("hi" 1 there #\c #t #f (a b c) (a b . c) (a b c ..2) #(a b c)
|
|
#(a b c ..2) #&(a b c) ,(a b c) ,(c1 d . e) ,(f g h ...)
|
|
,#(i j k) ,#&(l m n o) ,@(1 2 3 4 p))
|
|
(list a b c c1 d e f g h i j k l m n o p)))
|
|
'(1 2 3 4 5 6 7 8 (9) 10 11 12 13 14 15 16 17))
|
|
|
|
(mytest (match (box (list "hi" 1 'there #\c #t #f '(a b c) '(a b . c)
|
|
'(a b c c c c) #(a b c) #(a b c c c c) #&(a b c)
|
|
'(1 2 3) '(4 5 . 6) '(7 8 9) #(10 11 12)
|
|
#&(13 14 15 16) 1 2 3 4 17))
|
|
(`#&("hi" 1 there #\c #t #f (a b c) (a b . c) (a b c ..2) #(a b c)
|
|
#(a b c ..2) #&(a b c) ,(a b c) ,(c1 d . e) ,(f g h ...)
|
|
,#(i j k) ,#&(l m n o) ,@(1 2 3 4 p))
|
|
(list a b c c1 d e f g h i j k l m n o p)))
|
|
'(1 2 3 4 5 6 7 8 (9) 10 11 12 13 14 15 16 17))
|
|
|
|
(mytest (match '(1 2 3 4)
|
|
(`(,@`(,x ,y) ,@`(,a ,b)) (list x y a b)))
|
|
'(1 2 3 4))
|
|
|
|
|
|
;; deep nesting
|
|
|
|
(mytest (match #(#(#(1 2 3) #(1 2 3) #(2 3 4)) #(#(1 2 3) #(1 2 3) #(2 3 4)))
|
|
(#(#(#(a ...) ...) ...) a))
|
|
'(((1 2 3) (1 2 3) (2 3 4)) ((1 2 3) (1 2 3) (2 3 4))))
|
|
|
|
(mytest (match '(((1 2 3) (1 2 3) (2 3 4)) ((1 2 3) (1 2 3) (2 3 4)))
|
|
((((a ...) ...) ...) a))
|
|
'(((1 2 3) (1 2 3) (2 3 4)) ((1 2 3) (1 2 3) (2 3 4))))
|
|
|
|
(mytest (match '((((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))
|
|
(((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))))
|
|
(((((((a ...) ...) ...) ...) ...) ...) a))
|
|
'((((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))
|
|
(((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))))
|
|
|
|
|
|
(mytest (match #(#(#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))
|
|
#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8)))))
|
|
#(#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))
|
|
#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))))
|
|
(#(#(#(#(#(#(a ...) ...) ...) ...) ...) ...) a))
|
|
'((((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))
|
|
(((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))))
|
|
|
|
(mytest (match '(#((#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))
|
|
(#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8)))))
|
|
#((#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))
|
|
(#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))))
|
|
((#((#((#(a ...) ...) ...) ...) ...) ...) a))
|
|
'((((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))
|
|
(((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))))
|
|
|
|
(mytest (match '((((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))
|
|
(((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))))
|
|
(((((((a ..2) ..2) ..2) ..2) ..2) ..2) a))
|
|
'((((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))
|
|
(((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))))
|
|
|
|
|
|
|
|
(mytest (match #(#(#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))
|
|
#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8)))))
|
|
#(#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))
|
|
#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))))
|
|
(#(#(#(#(#(#(a ..2) ..2) ..2) ..2) ..2) ..2) a))
|
|
'((((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))
|
|
(((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))))
|
|
|
|
(mytest (match '(#((#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))
|
|
(#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8)))))
|
|
#((#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))
|
|
(#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))))
|
|
((#((#((#(a ..2) ..2) ..2) ..2) ..2) ..2) a))
|
|
'((((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))
|
|
(((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))))
|
|
|
|
|
|
(mytest (match '((((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))
|
|
(((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))))
|
|
(((((((_ ...) ...) ...) ...) ...) ...) #t)
|
|
(_ #f))
|
|
#t)
|
|
|
|
(mytest (match #(#(#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))
|
|
#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8)))))
|
|
#(#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))
|
|
#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))))
|
|
(#(#(#(#(#(#(_ ...) ...) ...) ...) ...) ...) #t)
|
|
(_ #f))
|
|
#t)
|
|
|
|
(mytest (match '(#((#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))
|
|
(#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8)))))
|
|
#((#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))
|
|
(#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))))
|
|
((#((#((#(_ ...) ...) ...) ...) ...) ...) #t)
|
|
(_ #f))
|
|
#t)
|
|
|
|
(mytest (match '((((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8)))))
|
|
(((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))
|
|
((((1 2) (3 4)) ((5 6) (7 8))) (((1 2) (3 4)) ((5 6) (7 8))))))
|
|
(((((((a b) ...) ...) ...) ...) ...) (list a b)))
|
|
'((((((1 3) (5 7)) ((1 3) (5 7))) (((1 3) (5 7)) ((1 3) (5 7)))) ((((1 3) (5 7)) ((1 3) (5 7))) (((1 3) (5 7)) ((1 3) (5 7)))))
|
|
(((((2 4) (6 8)) ((2 4) (6 8))) (((2 4) (6 8)) ((2 4) (6 8)))) ((((2 4) (6 8)) ((2 4) (6 8))) (((2 4) (6 8)) ((2 4) (6 8)))))))
|
|
|
|
|
|
(mytest (match #(#(#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))
|
|
#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8)))))
|
|
#(#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))
|
|
#(#(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))) #(#(#(1 2) #(3 4)) #(#(5 6) #(7 8))))))
|
|
(#(#(#(#(#(#(a b) ...) ...) ...) ...) ...) (list a b)))
|
|
'((((((1 3) (5 7)) ((1 3) (5 7))) (((1 3) (5 7)) ((1 3) (5 7)))) ((((1 3) (5 7)) ((1 3) (5 7))) (((1 3) (5 7)) ((1 3) (5 7)))))
|
|
(((((2 4) (6 8)) ((2 4) (6 8))) (((2 4) (6 8)) ((2 4) (6 8)))) ((((2 4) (6 8)) ((2 4) (6 8))) (((2 4) (6 8)) ((2 4) (6 8)))))))
|
|
|
|
(mytest (match '(#((#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))
|
|
(#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8)))))
|
|
#((#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))
|
|
(#((#(1 2) #(3 4)) (#(5 6) #(7 8))) #((#(1 2) #(3 4)) (#(5 6) #(7 8))))))
|
|
((#((#((#(a b) ...) ...) ...) ...) ...) (list a b)))
|
|
'((((((1 3) (5 7)) ((1 3) (5 7))) (((1 3) (5 7)) ((1 3) (5 7)))) ((((1 3) (5 7)) ((1 3) (5 7))) (((1 3) (5 7)) ((1 3) (5 7)))))
|
|
(((((2 4) (6 8)) ((2 4) (6 8))) (((2 4) (6 8)) ((2 4) (6 8)))) ((((2 4) (6 8)) ((2 4) (6 8))) (((2 4) (6 8)) ((2 4) (6 8)))))))
|
|
|
|
|
|
;the new var pattern
|
|
; this allows one to use
|
|
; var, $, =, and, or, not, ?, set!, or get!
|
|
; as pattern variables
|
|
; (mytest (match '(1 2 3)
|
|
; (((var $) b c) (list $ b c)))
|
|
; '(1 2 3))
|
|
|
|
; (mytest (match '(1 2 3)
|
|
; (((var var) b c) (list var b c)))
|
|
; '(1 2 3))
|
|
|
|
; (mytest (match '(1 2 3)
|
|
; (((var =) b c) (list = b c)))
|
|
; '(1 2 3))
|
|
|
|
; (mytest (match '(1 2 3)
|
|
; (((var and) b c) (list and b c)))
|
|
; '(1 2 3))
|
|
|
|
; (mytest (match '(1 2 3)
|
|
; (((var or) b c) (list or b c)))
|
|
; '(1 2 3))
|
|
|
|
; (mytest (match '(1 2 3)
|
|
; (((var not) b c) (list not b c)))
|
|
; '(1 2 3))
|
|
|
|
; (mytest (match '(1 2 3)
|
|
; (((var ?) b c) (list ? b c)))
|
|
; '(1 2 3))
|
|
|
|
; (mytest (match '(1 2 3)
|
|
; (((var set!) b c) (list set! b c)))
|
|
; '(1 2 3))
|
|
|
|
; (mytest (match '(1 2 3)
|
|
; (((var get!) b c) (list get! b c)))
|
|
; '(1 2 3))
|
|
|
|
|
|
(mytest (match '((1 1 2 2) (1 1 2 2) 5 5 5)
|
|
(((1 ... a ...) ... 7 ...) #f)
|
|
(((1 ... a ...) ... 6 ...) #f)
|
|
(((1 ... a ...) ... 5 ...) a))
|
|
'((2 2) (2 2)))
|
|
|
|
(mytest (match '(1 1 1 1 1 2 2 2 2)
|
|
((1 ... 2 2 2 2) #t))
|
|
#t)
|
|
(mytest (match '(1 1 1 1 1 2 2 2 2)
|
|
((1 ... 2 ...) #t))
|
|
#t)
|
|
|
|
(mytest (match '(1 1 1 1 1 2 2 2 2)
|
|
(((and (not 2) a) ... 2 ...) a))
|
|
'(1 1 1 1 1))
|
|
|
|
(mytest (match '(1 1 1 1 1 2 2 2 2)
|
|
((a ... 2 ...) a))
|
|
'(1 1 1 1 1 2 2 2 2))
|
|
|
|
(mytest (match '(1 1 1 1 1 2 2 2 2)
|
|
((_ ... 2 ...) #t))
|
|
#t)
|
|
|
|
(mytest (match '(pattern matching in scheme is very cool)
|
|
(((and (not 'in) a) ... (and (not 'is) b) ... c ...) (list a c b)))
|
|
'((pattern matching) (is very cool) (in scheme)))
|
|
|
|
(mytest (match '((1 1 2 2) (1 1 2 2) 5 5 5)
|
|
(((1 ... 2 ...) ... 5 ...) #t))
|
|
#t)
|
|
|
|
(mytest (match #(1 3 1 9 8 4 2 2 4 7 a b c) (#((and (? odd?) a) ... 8 (and (? even?) b) ... 7 r ...) (list a b r)))
|
|
'((1 3 1 9) (4 2 2 4) (a b c)))
|
|
|
|
(mytest (match #(#(1 1 2 2) #(1 1 2 2) 5 5 5)
|
|
(#(#(1 ... 2 ...) ... 5 ...) #t))
|
|
#t)
|
|
|
|
|
|
(mytest (match #(#(1 1 2 2) #(1 1 2 2) 5 5 5)
|
|
(#(#(1 ... a ...) ... 7 ...) #f)
|
|
(#(#(1 ... a ...) ... 6 ...) #f)
|
|
(#(#(1 ... a ...) ... 5 ...) a))
|
|
'((2 2) (2 2)))
|
|
|
|
(mytest (match #(#(1 2) #(1 2) #(1 2) 5 6)
|
|
[#(#(_ _) ..3 a ...) a])
|
|
'(5 6))
|
|
; should not work
|
|
; (match x ((... ...) #t))
|
|
|
|
|
|
; should not work
|
|
; (match x ((pat ... ... pat) #t))
|
|
|
|
(mytest (match #(1 2 3 4 5) (#(a b (and c (not 5)) ... d) (list a b c d)))
|
|
'(1 2 (3 4) 5))
|
|
|
|
)))
|