106-case-lambda.scm (1638B)
1 ; (case-lambda (formals body...) ...) -- pick the first clause whose 2 ; formals match the call's arity. Formals follow the same shape as 3 ; lambda: (a b), (), (a b . rest), or rest-symbol. 4 5 ;; --- Plain arity dispatch ----------------------------------------------- 6 (define f (case-lambda 7 (() 100) 8 ((x) (+ x 1)) 9 ((x y) (* x y)))) 10 (if (= 100 (f)) 0 (sys-exit 1)) 11 (if (= 4 (f 3)) 0 (sys-exit 2)) 12 (if (= 12 (f 3 4)) 0 (sys-exit 3)) 13 14 ;; --- First matching clause wins ------------------------------------------ 15 (define g (case-lambda 16 ((x) 'first) 17 ((x) 'second))) 18 (if (eq? 'first (g 7)) 0 (sys-exit 4)) 19 20 ;; --- Rest argument clause: variadic match -------------------------------- 21 (define h (case-lambda 22 (() 'none) 23 ((x) (list 'one x)) 24 (xs (cons 'many xs)))) 25 (if (eq? 'none (h)) 0 (sys-exit 5)) 26 (if (equal? (h 9) (list 'one 9)) 0 (sys-exit 6)) 27 (if (equal? (h 1 2 3) (cons 'many (list 1 2 3))) 0 (sys-exit 7)) 28 29 ;; --- Improper formals: (a . rest) ---------------------------------------- 30 (define k (case-lambda 31 ((a) 'lone) 32 ((a . rest) (cons a rest)))) 33 (if (eq? 'lone (k 5)) 0 (sys-exit 8)) 34 (if (equal? (k 1 2 3) (list 1 2 3)) 0 (sys-exit 9)) 35 36 ;; --- Closes over the enclosing environment ------------------------------- 37 (define base 10) 38 (define add (case-lambda 39 ((x) (+ base x)) 40 ((x y) (+ (+ base x) y)))) 41 (if (= 11 (add 1)) 0 (sys-exit 10)) 42 (if (= 13 (add 1 2)) 0 (sys-exit 11)) 43 44 ;; --- Higher-order: case-lambda result is a procedure -------------------- 45 (if (procedure? f) 0 (sys-exit 12)) 46 47 (sys-exit 42)