(define-library (csc match)
  (export match)
  (import (scheme base))
  (begin


    (define-syntax matches?
      (syntax-rules (! _)
        ((matches? x _) #t)
        ((matches? x (! bind)) #t)
        ((matches? x (pattern))
         (and (= 1 (length x))
              (matches? (car x) pat)))
        ((matches? x (pattern pattern1 pattern2 ...))
         (and (pair? x)
              (matches? (car x) pattern)
              (matches? (cdr x) (pattern1 pattern2 ...))))
        ((matches? x lit)
         (eqv? lit x))))


    (define-syntax bind-pattern
      (syntax-rules (! _)
        ((bind-pattern x '() result1 result2 ...)
         (begin result1 result2 ...))
        ((bind-pattern x _ result1 result2 ...)
         (begin result1 result2 ...))
        ((bind-pattern x (! bind) result1 result2 ...)
         (let ((bind x))
           result1 result2 ...))
        ((bind-pattern x (pattern) result1 result2 ...)
         (bind-pattern (car x) pattern result1 result2 ...))
        ((bind-pattern x (pattern pattern1 pattern2 ...) result1 result2 ...)
         (bind-pattern (car x) pattern
           (bind-pattern (cdr x) (pattern1 pattern2 ...) result1 result2 ...)))
        ((bind-pattern x lit result1 result2 ...)
         (begin result1 result2 ...))))


    (define-syntax match
      (syntax-rules ()
        ((match x (pattern result1 result2 ...))
         (if (matches? x pattern)
           (bind-pattern x pattern result1 result2 ...)))
        ((match x (pattern result1 result2 ...) clause1 clause2 ...)
         (if (matches? x pattern)
           (bind-pattern x pattern result1 result2 ...)
           (match x clause1 clause2 ...)))))))