Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
classmethod idea w/mop
(defpackage :clap-metas)
(defclass clap-metas::clap-base--meta (standard-class) ())
(defmethod clos:ensure-class-using-class :around ((class null) name
&rest options
&key metaclass
(when (not metaclass)
(let ((parent-meta
(some (lambda (c)
(let ((cl (find-class c)))
(clos:finalize-inheritance cl)
(some (lambda (cc)
(and (typep cc 'clap-metas::clap-base--meta)
(class-of cc)))
(clos:class-precedence-list cl))))
(when parent-meta
(let ((meta (intern (format nil "~a--meta" name) :clap-metas)))
(clos:ensure-class meta :direct-superclasses `(,(class-name parent-meta)))
(setf options `(:metaclass ,meta ,@options))))))
(apply #'call-next-method class name options))
(defmacro define-class-generic (name (arg &rest args) &rest options)
(defgeneric ,name (arg ,@args) ,@options)
(defmethod ,name ((class symbol) ,@args)
(,name (find-class class) ,@args))))
(defmacro define-class-method (name ((arg class-name) &rest args) &body body)
(let ((meta (intern (format nil "~a--meta" class-name) :clap-metas)))
`(defmethod ,name ((class ,meta) ,@args) ,@body)))
(defclass clap-base () () (:metaclass clap-metas::clap-base--meta))
(defclass my-class1 (clap-base) ())
(defclass my-class2 (my-class1) ())
(define-class-generic classmeth (class x) (:documentation "sample"))
(define-class-method classmeth ((class clap-base) x) `("Base" ,x))
(define-class-method classmeth ((class my-class2) x) `("Derived" ,x))
;;(classmeth 'clap-base 'a) => ("Base" a)
;;(classmeth 'my-class1 'a) => ("Base" a)
;;(classmeth 'my-class2 'a) => ("Derived" a)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.