match.zp

(define-syntax match
  (syntax-rules ()
    ((_ args matcher)
      (eval (macro-expand (match:manual args 'matcher))))))

(define (match:manual args matchers)
  (define (zip-pairs a b)
    (if (or (null? a) (null? b))
      '()
      (++ (list (list (head a) (head b))) (zip-pairs (tail a) (tail b)))))
  (define (_match-single a b)
      (filter (lambda (x) (not (null? x)))
              (map _single (zip-pairs a b))))
  (define (_single x)
    (let ((pattern (car x))
          (to-match (cadr x)))
      (cond 
        ((eq? pattern '_) '())
        ((symbol? pattern) (list pattern to-match))
        ((vector? pattern)
          (if (vector? to-match)
            (_match-single (vector->list pattern) (vector->list to-match))
            [:invalid]))
        ((list? pattern) (if (list? to-match) (_match-single pattern to-match) [:invalid]))
        (else (if (eq? pattern to-match) '() [:invalid])))))
  (define (_red acc x)
    (if (and (null? acc) (eq? (length (car x)) (length args)))
      (let ((matched (_match-single (car x) args)))
        (if (in? matched [:invalid])
          acc
          (list (list (list:flatten matched)) (cadr x))))
      acc))
  (let ((found (reduce _red [] matchers)))
    (if (> (length found) 0)
      (if (and (> (length (car found)) 0)
               (not (all? null? (car found))))
        (list 'let (car found) (cadr found))
        (cadr found)))))