(defpackage :patmatch
   (:use :cl :alexandria :serapeum)
   (:export pat-match))
 (in-package :patmatch)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defgeneric handle-pattern (pattern form &rest args)
     (:method ((pattern cons) form &rest args)
       (let ((val-sym (gensym "VAL")))
         (destructuring-bind (car cdr) args
           `((,val-sym ,form)
             (,car (car ,val-sym))
             (,cdr (cdr ,val-sym))))))
 
     (:method ((pattern vector) form &rest args)
       (let ((val-sym (gensym "VAL")))
         `((,val-sym ,form)
           ,@ (loop for arg in args
                 for idx from 0
                 collect `(,arg (aref ,val-sym ,idx))))))
 
     (:method ((pattern hash-table) form &rest args)
       (let* ((val-sym (gensym "VAL"))
              (binding-forms (loop for (key sym) in args
                                append `((,sym (gethash ',key ,val-sym))))))
         `((,val-sym ,form)
           ,@binding-forms)))
 
     (:method ((pattern symbol) form &rest args)
       (apply #'handle-pattern
              (closer-mop:class-prototype
               (find-class pattern))
              form
              args)))) 
 
 (defmacro pattern-match ((&rest clauses) &body body)
   `(let* (,@ (loop for ((discriminator . args) val-form) in clauses
                 append (apply 'handle-pattern discriminator val-form args)))
      ,@body))
 
 
 
 (pattern-match (((hash-table (:a a) (:b b)) (plist-hash-table '(:a 1 :b 2))))
   (+ a b))