(in-package #:tempores.macros)

(defmacro make-equality (class &body test-defs)
  `(defmethod == ((a ,class) (b ,class))
     (declare (optimize (speed 3)))
     (and ,@(loop for (slot . test) in test-defs
                  for test-val = (or (car test) 'eql)
                  collect `(,test-val (slot-value a ',slot)
                                      (slot-value b ',slot))))))

(defmacro make-simple-equality (class &key (test 'eql) &environment env)
  (let ((class-def (find-class class t env)))
    `(defmethod == ((a ,class) (b ,class))
       (declare (optimize (speed 3)))
       (and ,@(loop for slot in (closer-mop:class-direct-slots class-def)
                    collect (let ((slot (closer-mop:slot-definition-name slot)))
                              `(,test (slot-value a ',slot)
                                      (slot-value b ',slot))))))))

(defmacro defmethod-and-inverse (name (arga argb) &body body)
  `(progn
     (defmethod ,name (,arga ,argb)
       (declare (optimize (speed 3)))
       ,@body)
     (defmethod ,name (,argb ,arga)
       (declare (optimize (speed 3)))
       ,@body)))

(defmacro define-printer ((obj stream &key (type t) (identity t)) (&body pretty) (&body normal))
  `(defmethod print-object ((,obj ,obj) ,stream)
     (if *print-pretty*
       (progn
         ,@pretty)
       (print-unreadable-object (,obj ,stream :type ,type :identity ,identity)
         ,@normal))))

(defmacro quick-equalities (&body defs)                        
  `(progn                                                     
     ,@(loop for (name test)  in defs                         
             collect (list 'make-equality name :test test))))