087-pmatch-binders.scm (1358B)
1 ; pmatch — binders, wildcards, nested patterns, improper-tail binders. 2 3 ;; Single binder (subject is an atom). 4 (if (= 5 5 (pmatch 5 6 (,x x))) 7 0 (sys-exit 1)) 8 9 ;; Wildcard ,_ matches but introduces no binding. 10 (if (= 7 11 (pmatch 99 12 (,_ 7))) 13 0 (sys-exit 2)) 14 15 ;; Multiple binders in a flat list. 16 (if (= 5 17 (pmatch (cons 2 3) 18 ((,a . ,b) (+ a b)))) 19 0 (sys-exit 3)) 20 21 ;; Nested pattern. 22 (if (= 84 23 (pmatch '(if cond (op 40 44) else) 24 ((if ,t (op ,a ,b) ,e) (+ a b)))) 25 0 (sys-exit 4)) 26 27 ;; Improper-tail binder picks up the cdr. 28 (if (= 6 29 (pmatch '(1 2 3) 30 ((,h . ,t) (+ h (+ (car t) (car (cdr t))))))) 31 0 (sys-exit 5)) 32 33 ;; ptail = () enforces a proper list (equivalent to (,x ,y)). 34 (if (= 11 35 (pmatch '(a b) 36 ((,x ,y . ()) 11) 37 (else (sys-exit 6)))) 38 0 (sys-exit 7)) 39 40 ;; Same shape, improper subject, falls through to the explicit-tail clause. 41 (if (= 6 42 (pmatch (cons 1 (cons 2 3)) 43 ((,x ,y) (sys-exit 8)) ; demands proper list -> miss 44 ((,x ,y . ,t) (+ x (+ y t))) 45 (else (sys-exit 9)))) 46 0 (sys-exit 10)) 47 48 ;; Recursive sum exercises the same shape the compiler will use. 49 (define (sum xs) 50 (pmatch xs 51 (() 0) 52 ((,h . ,t) (+ h (sum t))))) 53 (if (= 15 (sum '(1 2 3 4 5))) 0 (sys-exit 9)) 54 55 (sys-exit 0)