Skip to content

Instantly share code, notes, and snippets.

@garaemon
Created December 8, 2010 17:55
Show Gist options
  • Save garaemon/733636 to your computer and use it in GitHub Desktop.
Save garaemon/733636 to your computer and use it in GitHub Desktop.
classmethod on clos
(defun extract-argument-symbols (args)
(mapcar #'(lambda (x) (if (listp x) (car x) x)) args))
(defconstant +built-in-class-instances-table+
`((arithmetic-error . ,(make-condition 'arithmetic-error))
...))
(defun lookup-built-in-class-object (class)
(cdr (assoc class +built-in-class-instances-table+)))
(defmacro define-class-method-wrapper (name args &optional (documentation nil))
;; args => ((class class-name) arg2 arg3 ...)
(let ((class-obj (gensym)))
`(defmethod ,name ((,(car (car args)) symbol) ,@(cdr args))
"this method was automatically generated by
DEFINE-CLASS-METHOD-WRAPPER."
(let ((,class-obj (find-class ',(cadr (car args)))))
(if (typep ,class-obj 'closer-mop:built-in-class)
(,name (lookup-built-in-class-object ',(cadr (car args)))
,(extract-argument-symbols (cdr args)))
(,name (allocate-instance ,class-obj)
,(extract-argument-symbols (cdr args)))))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment