summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2011-05-07 01:03:49 -0300
committerStefan Monnier <monnier@iro.umontreal.ca>2011-05-07 01:03:49 -0300
commitd1dc2cc2ce985d92e1d1309344eb49f7e3b29312 (patch)
treeed54cb83c1e6d312810470ce77acb7789720f36c /lisp/emacs-lisp
parent4d3fcc8e6025592929f95ac1e36b9313ffa6d4f0 (diff)
downloademacs-d1dc2cc2ce985d92e1d1309344eb49f7e3b29312.tar.gz
emacs-d1dc2cc2ce985d92e1d1309344eb49f7e3b29312.tar.bz2
emacs-d1dc2cc2ce985d92e1d1309344eb49f7e3b29312.zip
Make bytecomp.el understand that defmethod defines functions.
* lisp/emacs-lisp/eieio.el (eieio--defalias, eieio--defgeneric-init-form): New functions. (defgeneric, eieio--defmethod): Use them. (eieio-defgeneric): Remove. (defmethod): Call defgeneric in a way visible to the byte-compiler. Fixes: debbugs:8631
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/bytecomp.el1
-rw-r--r--lisp/emacs-lisp/eieio.el75
2 files changed, 44 insertions, 32 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 4c28d816f60..6ca8eed8ac6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4173,6 +4173,7 @@ binding slots have been popped."
;; Compile normally, but deal with warnings for the function being defined.
(put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias)
+;; Used for eieio--defalias as well.
(defun byte-compile-file-form-defalias (form)
(if (and (consp (cdr form)) (consp (nth 1 form))
(eq (car (nth 1 form)) 'quote)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 268698e4128..d71213bfac8 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -420,6 +420,7 @@ It creates an autoload function for CNAME's constructor."
(load-library (car (cdr (symbol-function cname))))))
(defun eieio-defclass (cname superclasses slots options-and-doc)
+ ;; FIXME: Most of this should be moved to the `defclass' macro.
"Define CNAME as a new subclass of SUPERCLASSES.
SLOTS are the slots residing in that class definition, and options or
documentation OPTIONS-AND-DOC is the toplevel documentation for this class.
@@ -1139,6 +1140,17 @@ a string."
;;; CLOS methods and generics
;;
+
+(put 'eieio--defalias 'byte-hunk-handler
+ #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler)
+(defun eieio--defalias (name body)
+ "Like `defalias', but with less side-effects.
+More specifically, it has no side-effects at all when the new function
+definition is the same (`eq') as the old one."
+ (unless (and (fboundp name)
+ (eq (symbol-function name) body))
+ (defalias name body)))
+
(defmacro defgeneric (method args &optional doc-string)
"Create a generic function METHOD.
DOC-STRING is the base documentation for this class. A generic
@@ -1147,7 +1159,21 @@ is appropriate to use. Uses `defmethod' to create methods, and calls
`defgeneric' for you. With this implementation the ARGS are
currently ignored. You can use `defgeneric' to apply specialized
top level documentation to a method."
- `(eieio-defgeneric (quote ,method) ,doc-string))
+ `(eieio--defalias ',method
+ (eieio--defgeneric-init-form ',method ,doc-string)))
+
+(defun eieio--defgeneric-init-form (method doc-string)
+ "Form to use for the initial definition of a generic."
+ (cond
+ ((or (not (fboundp method))
+ (eq 'autoload (car-safe (symbol-function method))))
+ ;; Make sure the method tables are installed.
+ (eieiomt-install method)
+ ;; Construct the actual body of this function.
+ (eieio-defgeneric-form method doc-string))
+ ((generic-p method) (symbol-function method)) ;Leave it as-is.
+ (t (error "You cannot create a generic/method over an existing symbol: %s"
+ method))))
(defun eieio-defgeneric-form (method doc-string)
"The lambda form that would be used as the function defined on METHOD.
@@ -1237,26 +1263,6 @@ IMPL is the symbol holding the method implementation."
(cdr entry)
))))
-(defun eieio-defgeneric (method doc-string)
- "Engine part to `defgeneric' macro defining METHOD with DOC-STRING."
- (if (and (fboundp method) (not (generic-p method))
- (or (byte-code-function-p (symbol-function method))
- (not (eq 'autoload (car (symbol-function method)))))
- )
- (error "You cannot create a generic/method over an existing symbol: %s"
- method))
- ;; Don't do this over and over.
- (unless (fboundp 'method)
- ;; This defun tells emacs where the first definition of this
- ;; method is defined.
- `(defun ,method nil)
- ;; Make sure the method tables are installed.
- (eieiomt-install method)
- ;; Apply the actual body of this function.
- (fset method (eieio-defgeneric-form method doc-string))
- ;; Return the method
- 'method))
-
(defun eieio-unbind-method-implementations (method)
"Make the generic method METHOD have no implementations.
It will leave the original generic function in place,
@@ -1292,12 +1298,17 @@ Summary:
(let* ((key (if (keywordp (car args)) (pop args)))
(params (car args))
(arg1 (car params))
- (class (if (consp arg1) (nth 1 arg1))))
- `(eieio--defmethod ',method ',key ',class
- (lambda ,(if (consp arg1)
- (cons (car arg1) (cdr params))
- params)
- ,@(cdr args)))))
+ (args (if (consp arg1)
+ (cons (car arg1) (cdr params))
+ params))
+ (class (if (consp arg1) (nth 1 arg1)))
+ (code `(lambda ,args ,@(cdr args))))
+ `(progn
+ ;; Make sure there is a generic and the byte-compiler sees it.
+ (defgeneric ,method ,args
+ ,(or (documentation code)
+ (format "Generically created method `%s'." method)))
+ (eieio--defmethod ',method ',key ',class ',code))))
(defun eieio--defmethod (method kind argclass code)
"Work part of the `defmethod' macro defining METHOD with ARGS."
@@ -1317,11 +1328,11 @@ Summary:
method-static)
;; Primary key
(t method-primary))))
- ;; make sure there is a generic
- (eieio-defgeneric
- method
- (or (documentation code)
- (format "Generically created method `%s'." method)))
+ ;; Make sure there is a generic (when called from defclass).
+ (eieio--defalias
+ method (eieio--defgeneric-init-form
+ method (or (documentation code)
+ (format "Generically created method `%s'." method))))
;; create symbol for property to bind to. If the first arg is of
;; the form (varname vartype) and `vartype' is a class, then
;; that class will be the type symbol. If not, then it will fall