From 909126de0f6d2e53aec44c97abccee5b32b25f28 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 17 Jan 2015 22:50:50 -0500 Subject: [PATCH] * lisp/emacs-lisp/cl-generic.el: Add support for cl-next-method-p. (cl-defmethod): Add edebug spec. (cl--generic-build-combined-method): Fix call to cl-no-applicable-method. (cl--generic-nnm-sample, cl--generic-cnm-sample): New constant. (cl--generic-isnot-nnm-p): New function. (cl--generic-lambda): Use it to add support for cl-next-method-p. (cl-no-next-method, cl-no-applicable-method): Simplify arg list. (cl-next-method-p): New function. --- lisp/ChangeLog | 20 +++++++++- lisp/emacs-lisp/cl-generic.el | 72 ++++++++++++++++++++++++++++++----- lisp/emacs-lisp/eieio.el | 8 ++-- 3 files changed, 84 insertions(+), 16 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cce686b5f1d..ace8d2231a8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,19 @@ +2015-01-18 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl-defstruct): Minor optimization when include + or print is nil. + (cl-struct-type-p): New function. + + * emacs-lisp/cl-generic.el: Add support for cl-next-method-p. + (cl-defmethod): Add edebug spec. + (cl--generic-build-combined-method): Fix call to + cl-no-applicable-method. + (cl--generic-nnm-sample, cl--generic-cnm-sample): New constant. + (cl--generic-isnot-nnm-p): New function. + (cl--generic-lambda): Use it to add support for cl-next-method-p. + (cl-no-next-method, cl-no-applicable-method): Simplify arg list. + (cl-next-method-p): New function. + 2015-01-17 Ulrich Müller * version.el (emacs-repository-get-version): Update docstring. @@ -14,8 +30,8 @@ in place of the file name while working on non-file buffers, just like hack-dir-local-variables already does. (Bug#19140) - * textmodes/enriched.el (enriched-encode): Use - inhibit-point-motion-hooks in addition to inhibit-read-only. + * textmodes/enriched.el (enriched-encode): + Use inhibit-point-motion-hooks in addition to inhibit-read-only. (Bug#18246) * desktop.el (desktop-read): Do not call desktop-clear when no diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index ae0f129bb23..819e2e92888 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -26,8 +26,7 @@ ;; The main entry points are: `cl-defgeneric' and `cl-defmethod'. ;; Missing elements: -;; - We don't support next-method-p, make-method, call-method, -;; define-method-combination. +;; - We don't support make-method, call-method, define-method-combination. ;; - Method and generic function objects: CLOS defines methods as objects ;; (same for generic functions), whereas we don't offer such an abstraction. ;; - `no-next-method' should receive the "calling method" object, but since we @@ -133,7 +132,7 @@ They should be sorted from most specific to least specific.") "Create a generic function NAME. DOC-STRING is the base documentation for this class. A generic function has no body, as its purpose is to decide which method body -is appropriate to use. Specific methods are defined with `defmethod'. +is appropriate to use. Specific methods are defined with `cl-defmethod'. With this implementation the ARGS are currently ignored. OPTIONS-AND-METHODS is currently only used to specify the docstring, via (:documentation DOCSTRING)." @@ -223,8 +222,10 @@ This macro can only be used within the lexical scope of a cl-generic method." (let* ((doc-string (and doc-string (stringp (car body)) (pop body))) (cnm (make-symbol "cl--cnm")) + (nmp (make-symbol "cl--nmp")) (nbody (macroexpand-all - `(cl-flet ((cl-call-next-method ,cnm)) + `(cl-flet ((cl-call-next-method ,cnm) + (cl-next-method-p ,nmp)) ,@body) macroenv)) ;; FIXME: Rather than `grep' after the fact, the @@ -232,11 +233,15 @@ This macro can only be used within the lexical scope of a cl-generic method." ;; is used. ;; FIXME: Also, optimize the case where call-next-method is ;; only called with explicit arguments. - (uses-cnm (cl--generic-fgrep (list cnm) nbody))) + (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody))) (cons (not (not uses-cnm)) `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) ,@(if doc-string (list doc-string)) - ,nbody)))) + ,(if (not (memq nmp uses-cnm)) + nbody + `(let ((,nmp (lambda () + (cl--generic-isnot-nnm-p ,cnm)))) + ,nbody)))))) (f (error "Unexpected macroexpansion result: %S" f)))))))) @@ -261,7 +266,15 @@ Other than a type, TYPE can also be of the form `(eql VAL)' in which case this method will be invoked when the argument is `eql' to VAL. \(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" - (declare (doc-string 3) (indent 2)) + (declare (doc-string 3) (indent 2) + (debug + (&define ; this means we are defining something + [&or name ("setf" :name setf name)] + ;; ^^ This is the methods symbol + [ &optional keywordp ] ; this is key :before etc + list ; arguments + [ &optional stringp ] ; documentation string + def-body))) ; part to be debugged (let ((qualifiers nil)) (while (keywordp args) (push args qualifiers) @@ -402,7 +415,8 @@ for all those different tags in the method-cache.") cl--generic-combined-method-memoization) (cond ((null mets-by-qual) (lambda (&rest args) - (cl-no-applicable-method generic-name args))) + (apply #'cl-no-applicable-method + generic-name args))) (t (let* ((fun (lambda (&rest args) ;; FIXME: CLOS passes as second arg the "calling method". @@ -428,6 +442,38 @@ for all those different tags in the method-cache.") (apply af args))))))) (cl--generic-nest fun (alist-get :around mets-by-qual)))))))) +(defconst cl--generic-nnm-sample + (cl--generic-build-combined-method nil '(((specializer . :qualifier))))) +(defconst cl--generic-cnm-sample + (funcall (cl--generic-build-combined-method + nil `(((specializer . :primary) t . ,#'identity))))) + +(defun cl--generic-isnot-nnm-p (cnm) + "Return non-nil if CNM is the function that calls `cl-no-next-method'." + ;; ¡Big Gross Ugly Hack! + ;; `next-method-p' just sucks, we should let it die. But EIEIO did support + ;; it, and some packages use it, so we need to support it. + (catch 'found + (cl-assert (function-equal cnm cl--generic-cnm-sample)) + (if (byte-code-function-p cnm) + (let ((cnm-constants (aref cnm 2)) + (sample-constants (aref cl--generic-cnm-sample 2))) + (dotimes (i (length sample-constants)) + (when (function-equal (aref sample-constants i) + cl--generic-nnm-sample) + (throw 'found + (not (function-equal (aref cnm-constants i) + cl--generic-nnm-sample)))))) + (cl-assert (eq 'closure (car-safe cl--generic-cnm-sample))) + (let ((cnm-env (cadr cnm))) + (dolist (vb (cadr cl--generic-cnm-sample)) + (when (function-equal (cdr vb) cl--generic-nnm-sample) + (throw 'found + (not (function-equal (cdar cnm-env) + cl--generic-nnm-sample)))) + (setq cnm-env (cdr cnm-env))))) + (error "Haven't found no-next-method-sample in cnm-sample"))) + (defun cl--generic-cache-miss (generic dispatch-arg dispatches-left tags) (let ((types (apply #'append (mapcar cl-generic-tag-types-function tags))) (methods '())) @@ -452,12 +498,12 @@ for all those different tags in the method-cache.") (cl-defgeneric cl-no-next-method (generic method &rest args) "Function called when `cl-call-next-method' finds no next method.") -(cl-defmethod cl-no-next-method ((generic t) method &rest args) +(cl-defmethod cl-no-next-method (generic method &rest args) (signal 'cl-no-next-method `(,generic ,method ,@args))) (cl-defgeneric cl-no-applicable-method (generic &rest args) "Function called when a method call finds no applicable method.") -(cl-defmethod cl-no-applicable-method ((generic t) &rest args) +(cl-defmethod cl-no-applicable-method (generic &rest args) (signal 'cl-no-applicable-method `(,generic ,@args))) (defun cl-call-next-method (&rest _args) @@ -465,6 +511,12 @@ for all those different tags in the method-cache.") Can only be used from within the lexical body of a primary or around method." (error "cl-call-next-method only allowed inside primary and around methods")) +(defun cl-next-method-p () + "Return non-nil if there is a next method. +Can only be used from within the lexical body of a primary or around method." + (declare (obsolete "make sure there's always a next method, or catch `cl-no-next-method' instead" "25.1")) + (error "cl-next-method-p only allowed inside primary and around methods")) + ;;; Add support for describe-function (defun cl--generic-search-method (met-name) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index cda0c97a64f..c5597b83170 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -36,12 +36,12 @@ ;; Retrieved from: ;; http://192.220.96.201/dylan/linearization-oopsla96.html -;; There is funny stuff going on with typep and deftype. This -;; is the only way I seem to be able to make this stuff load properly. - ;; @TODO - fix :initform to be a form, not a quoted value ;; @TODO - Prefix non-clos functions with `eieio-'. +;; TODO: better integrate CL's defstructs and classes. E.g. make it possible +;; to create a new class that inherits from a struct. + ;;; Code: (defvar eieio-version "1.4" @@ -924,7 +924,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "9a908efef1720439feb6323c1dd01770") +;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "6baa78cfc590cc0422e12b7eb55abf24") ;;; Generated autoloads from eieio-custom.el (autoload 'customize-object "eieio-custom" "\ -- 2.39.2