; uncle bob's bowling game kata
(define-syntax list-match
(syntax-rules ()
((_ expr (pattern fender ... template) ...)
(let ((obj expr))
(cond ((list-match-aux obj pattern fender ...
(list template)) => car) ...
(else (error 'list-match "pattern failure")))))))
(define-syntax list-match-aux
(lambda (stx)
(define (underscore? x)
(and (identifier? x) (free-identifier=? x (syntax _))))
(syntax-case stx (quote quasiquote)
((_ obj pattern template)
(syntax (list-match-aux obj pattern #t template)))
((_ obj () fender template)
(syntax (and (null? obj) fender template)))
((_ obj underscore fender template)
(underscore? (syntax underscore))
(syntax (and fender template)))
((_ obj var fender template)
(identifier? (syntax var))
(syntax (let ((var obj)) (and fender template))))
((_ obj (quote datum) fender template)
(syntax (and (equal? obj (quote datum)) fender template)))
((_ obj (quasiquote datum) fender template)
(syntax (and (equal? obj (quasiquote datum)) fender template)))
((_ obj (kar . kdr) fender template)
(syntax (and (pair? obj)
(let ((kar-obj (car obj)) (kdr-obj (cdr obj)))
(list-match-aux kar-obj kar
(list-match-aux kdr-obj kdr fender template))))))
((_ obj const fender template)
(syntax (and (equal? obj const) fender template))))))
(define (pins . xs)
(list-match xs
((10 a b . x) (+ 10 a b (if (null? x) 0 (apply pins a b x))))
((a b c . x) (= (+ a b) 10) (+ 10 c (if (null? x) 0 (apply pins c x))))
((a b . x) (+ a b (if (null? x) 0 (apply pins x))))))
(display (pins 1 4 4 5 6 4 5 5 10 0 1 7 3 6 4 10 2 8 6))