(defpackage :patmatch/test
  (:use :cl)
  (:import-from :parachute
                #:true #:false #:fail #:is #:isnt #:is-values #:isnt-values
                #:of-type #:finish #:define-test)
  (:import-from :patmatch :let-pat*)
  (:export ))
(in-package :patmatch/test)

(defclass test-base ()
  ((a :initform 1)))

(defclass test-sub1 (test-base)
  ())

(defclass test-sub2 (test-base)
  ((b :initform 2)))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (closer-mop:ensure-class 'test-base)
  (closer-mop:ensure-class 'test-sub1)
  (closer-mop:ensure-class 'test-sub2))

(defmethod patmatch:handle-pattern append ((pattern test-base) form &rest args)
  (alexandria:when-let ((arg (getf args :a)))
    (let ((val-sym (gensym "test-base-")))
      `((,val-sym ,form)
        ,@(serapeum:unsplice
           `(,arg (slot-value ,val-sym 'a)))))))

(defmethod patmatch:handle-pattern append ((pattern test-sub2) form &rest args)
  (alexandria:when-let ((arg (getf args :b)))
    (let ((val-sym (gensym "test-base-")))
      `((,val-sym ,form)
        ,@(serapeum:unsplice
           `(,arg (slot-value ,val-sym 'b)))))))