gistfile1.clj

(defmacro matchfn
  "Compiles a pattern match to a lambda that matches against it's parameters.
  Patterns are analyzed and if no pattern contains varargs (&) then patterns will be split in to 
  different fn aritity overloads. If & is present in one or more patterns all arguments are captured
  in to args seq and matching is done on it as ([pattern] :seq)."
  [& body]
  (let [fname (if (symbol? (first body)) (first body) nil)
        cases (if fname (rest body) body)
        pattern-expression (partition 2 cases)
        pattern-varargs (some (fn [[pattern _]] (when-not (= :else pattern) (some (partial = '&) pattern))) pattern-expression)]
    (assert (every? (fn [[pattern _]] (vector? pattern)) pattern-expression) "matchfn patterns must be specified with vectors")
    (if pattern-varargs
      `(fn ~@(when fname [fname]) [& fnargs#]
         (match [fnargs#]
           ~@(->>
               (for [[pattern expression] pattern-expression] [[(list pattern :seq)] expression])
               (apply concat))))
      (let [cases-arity-grouped (group-by (fn [[pattern _]] (if (= :else pattern) :else (count pattern))) pattern-expression)]
        `(fn ~@(when fname [fname])
           ~@(let [else-group (:else cases-arity-grouped)
                   else-expression (when else-group (second (first else-group)))]
               (when else-group 
                 (assert (= (count else-group) 1) "more than one :else case provided to matchfn, only one is allowed"))
               (for [[arity pattern-expressions] cases-arity-grouped]
                 (let [argsyms (vec (repeatedly arity (partial gensym "mfn_arg__")))]
                   `(~argsyms 
                      (match ~argsyms
                        ~@cases
                        ~@(when else-expression [:else else-expression])))))))))))


; example usage

(matchfn
  [x (y :when int?)] [x y]
  [x y z] [x z y]
  :else [])