pattern.scm

(use srfi-1)
(use util.match)

(define (split-patterns l)
  (let* ((rest (car l)) (pats (cadr l)) (pos (list-index (pa$ eq? '->) rest)))
       (if (not (eq? pos #f))
           (split-patterns (cons (drop rest (+ pos 2))
                                 (list (append pats (list (take rest (+ pos 2)))))))
           pats)))

(define-macro (def name . pats)
  `(define ,name
     (match-lambda*
       ,@(map
          (lambda (clause)
            (receive (pat body)
              (split-at clause (list-index (pa$ eq? '->) clause))
              `(,pat ,(cadr body))))
          (split-patterns `(,pats ()))))))