diff options
| author | Stefan Monnier | 2017-07-26 23:22:58 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2017-07-26 23:22:58 -0400 |
| commit | 86c862767dbb501d27878efdb9f2664ccdd5cc4e (patch) | |
| tree | 4081f26632bc31c13e6b03b088e364a097e761c4 | |
| parent | e1e8d2e229f48b3cee765f7cf27ae04ee4401d85 (diff) | |
| download | emacs-86c862767dbb501d27878efdb9f2664ccdd5cc4e.tar.gz emacs-86c862767dbb501d27878efdb9f2664ccdd5cc4e.zip | |
* lisp/emacs-lisp/cl-generic.el (cl-generic-define-method):
Record this as the function's definition site if it's the first def.
| -rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 35 |
1 files changed, 18 insertions, 17 deletions
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 1d29082c621..114468239a5 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el | |||
| @@ -500,25 +500,26 @@ The set of acceptable TYPEs (also called \"specializers\") is defined | |||
| 500 | (cons method mt) | 500 | (cons method mt) |
| 501 | ;; Keep the ordering; important for methods with :extra qualifiers. | 501 | ;; Keep the ordering; important for methods with :extra qualifiers. |
| 502 | (mapcar (lambda (x) (if (eq x (car me)) method x)) mt))) | 502 | (mapcar (lambda (x) (if (eq x (car me)) method x)) mt))) |
| 503 | (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format | 503 | (let ((sym (cl--generic-name generic))) ; Actual name (for aliases). |
| 504 | (cl--generic-name generic) | 504 | (unless (symbol-function sym) |
| 505 | qualifiers specializers)) | 505 | (defalias sym 'dummy)) ;Record definition into load-history. |
| 506 | current-load-list :test #'equal) | 506 | (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format |
| 507 | ;; FIXME: Try to avoid re-constructing a new function if the old one | 507 | (cl--generic-name generic) |
| 508 | ;; is still valid (e.g. still empty method cache)? | 508 | qualifiers specializers)) |
| 509 | (let ((gfun (cl--generic-make-function generic)) | 509 | current-load-list :test #'equal) |
| 510 | ;; Prevent `defalias' from recording this as the definition site of | 510 | ;; FIXME: Try to avoid re-constructing a new function if the old one |
| 511 | ;; the generic function. | 511 | ;; is still valid (e.g. still empty method cache)? |
| 512 | current-load-list) | 512 | (let ((gfun (cl--generic-make-function generic)) |
| 513 | ;; For aliases, cl--generic-name gives us the actual name. | 513 | ;; Prevent `defalias' from recording this as the definition site of |
| 514 | (let ((purify-flag | 514 | ;; the generic function. |
| 515 | ;; BEWARE! Don't purify this function definition, since that leads | 515 | current-load-list |
| 516 | ;; to memory corruption if the hash-tables it holds are modified | 516 | ;; BEWARE! Don't purify this function definition, since that leads |
| 517 | ;; (the GC doesn't trace those pointers). | 517 | ;; to memory corruption if the hash-tables it holds are modified |
| 518 | nil)) | 518 | ;; (the GC doesn't trace those pointers). |
| 519 | (purify-flag nil)) | ||
| 519 | ;; But do use `defalias', so that it interacts properly with nadvice, | 520 | ;; But do use `defalias', so that it interacts properly with nadvice, |
| 520 | ;; e.g. for tracing/debug-on-entry. | 521 | ;; e.g. for tracing/debug-on-entry. |
| 521 | (defalias (cl--generic-name generic) gfun))))) | 522 | (defalias sym gfun))))) |
| 522 | 523 | ||
| 523 | (defmacro cl--generic-with-memoization (place &rest code) | 524 | (defmacro cl--generic-with-memoization (place &rest code) |
| 524 | (declare (indent 1) (debug t)) | 525 | (declare (indent 1) (debug t)) |