From: Stefan Monnier Date: Sat, 25 Dec 2021 04:50:31 +0000 (-0500) Subject: oclosure.el (oclosure-lambda): Change calling convention X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fe5457ff757ded7999610917f8f39d28b8908e6f;p=emacs.git oclosure.el (oclosure-lambda): Change calling convention * lisp/emacs-lisp/oclosure.el (oclosure-lambda): Change calling convention. * lisp/emacs-lisp/nadvice.el (advice--where-alist): * lisp/emacs-lisp/cl-generic.el (cl-generic-call-method): * lisp/kmacro.el (kmacro-lambda-form): Adjust accordingly. --- diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 1886f309e34..46fd2de4842 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -744,7 +744,7 @@ FUN is the function that should be called when METHOD calls (if fun (lambda (&rest cnm-args) (apply fun (or cnm-args args))) - (oclosure-lambda cl--generic-nnm () (&rest cnm-args) + (oclosure-lambda (cl--generic-nnm) (&rest cnm-args) (apply #'cl-no-next-method generic method (or cnm-args args)))) args))))) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 3a1c4a2a580..d49ac5ae25d 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -48,25 +48,25 @@ ;;;; Lightweight advice/hook (defvar advice--where-alist - `((:around ,(oclosure-lambda advice ((where :around)) (&rest args) + `((:around ,(oclosure-lambda (advice (where :around)) (&rest args) (apply car cdr args))) - (:before ,(oclosure-lambda advice ((where :before)) (&rest args) + (:before ,(oclosure-lambda (advice (where :before)) (&rest args) (apply car args) (apply cdr args))) - (:after ,(oclosure-lambda advice ((where :after)) (&rest args) + (:after ,(oclosure-lambda (advice (where :after)) (&rest args) (apply cdr args) (apply car args))) - (:override ,(oclosure-lambda advice ((where :override)) (&rest args) + (:override ,(oclosure-lambda (advice (where :override)) (&rest args) (apply car args))) - (:after-until ,(oclosure-lambda advice ((where :after-until)) (&rest args) + (:after-until ,(oclosure-lambda (advice (where :after-until)) (&rest args) (or (apply cdr args) (apply car args)))) - (:after-while ,(oclosure-lambda advice ((where :after-while)) (&rest args) + (:after-while ,(oclosure-lambda (advice (where :after-while)) (&rest args) (and (apply cdr args) (apply car args)))) - (:before-until ,(oclosure-lambda advice ((where :before-until)) (&rest args) + (:before-until ,(oclosure-lambda (advice (where :before-until)) (&rest args) (or (apply car args) (apply cdr args)))) - (:before-while ,(oclosure-lambda advice ((where :before-while)) (&rest args) + (:before-while ,(oclosure-lambda (advice (where :before-while)) (&rest args) (and (apply car args) (apply cdr args)))) - (:filter-args ,(oclosure-lambda advice ((where :filter-args)) (&rest args) + (:filter-args ,(oclosure-lambda (advice (where :filter-args)) (&rest args) (apply cdr (funcall car args)))) - (:filter-return ,(oclosure-lambda advice ((where :filter-return)) (&rest args) + (:filter-return ,(oclosure-lambda (advice (where :filter-return)) (&rest args) (funcall car (apply cdr args))))) "List of descriptions of how to add a function. Each element has the form (WHERE OCL) where OCL is a \"prototype\" diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index b88d108853f..d957236fa49 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -25,21 +25,24 @@ ;; with a notion of type (e.g. for defmethod dispatch) as well as the ;; ability to have some fields that are accessible from the outside. -;; Here are some cases of "callable objects" where OClosures might be useful: +;; Here are some cases of "callable objects" where OClosures are used: ;; - nadvice.el -;; - iterators (generator.el), thunks (thunk.el), streams (stream.el). ;; - kmacros (for cl-print and for `kmacro-extract-lambda') +;; - cl-generic: turn `cl--generic-isnot-nnm-p' into a mere type test +;; (by putting the no-next-methods into their own class). +;; - OClosure accessor functions, where the type-dispatch is used to +;; dynamically compute the docstring, and also to pretty them. +;; Here are other cases of "callable objects" where OClosures could be used: +;; - iterators (generator.el), thunks (thunk.el), streams (stream.el). ;; - PEG rules: they're currently just functions, but they should carry ;; their original (macro-expanded) definition (and should be printed ;; differently from functions)! -;; - cl-generic: turn `cl--generic-isnot-nnm-p' into a mere type test -;; (by putting the no-next-methods into their own class). ;; - documented functions: this could be a subtype of normal functions, which ;; simply has an additional `docstring' slot. ;; - commands: this could be a subtype of documented functions, which simply ;; has an additional `interactive-form' slot. -;; - auto-generate docstrings for slot accessors instead of storing them -;; in the accessor itself? +;; - auto-generate docstrings for cl-defstruct slot accessors instead of +;; storing them in the accessor itself? ;;; Code: @@ -251,17 +254,19 @@ No checking is performed," (if t nil ,@(mapcar #'car bindings)) ,@body))))) -(defmacro oclosure-lambda (type fields args &rest body) +(defmacro oclosure-lambda (type-and-slots args &rest body) "Define anonymous OClosure function. -TYPE should be an OClosure type. -FIELDS is a let-style list of bindings for the various slots of TYPE. -ARGS is and BODY are the same as for `lambda'." - (declare (indent 3) (debug (sexp (&rest (sexp form)) sexp def-body))) +TYPE-AND-SLOTS should be of the form (TYPE . SLOTS) +where TYPE is an OClosure type name and +SLOTS is a let-style list of bindings for the various slots of TYPE. +ARGS and BODY are the same as for `lambda'." + (declare (indent 2) (debug ((sexp &rest (sexp form)) sexp def-body))) ;; FIXME: Should `oclosure-define' distinguish "optional" from ;; "mandatory" slots, and/or provide default values for slots missing ;; from `fields'? (pcase-let* - ((class (cl--find-class type)) + ((`(,type . ,fields) type-and-slots) + (class (cl--find-class type)) (slots (oclosure--class-slots class)) (slotbinds (mapcar (lambda (slot) (list (cl--slot-descriptor-name slot))) diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 93a93a461ba..89df60f190b 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -823,7 +823,7 @@ If kbd macro currently being defined end it before activating it." ;; or only `mac' is provided, as a list (MAC COUNTER FORMAT). ;; The first is used from `insert-kbd-macro' and `edmacro-finish-edit', ;; while the second is used from within this file. - (oclosure-lambda kmacro-function ((mac (if counter (list mac counter format) mac))) + (oclosure-lambda (kmacro-function (mac (if counter (list mac counter format) mac))) (&optional arg) (interactive "p") (kmacro-exec-ring-item mac arg))) @@ -842,7 +842,7 @@ If kbd macro currently being defined end it before activating it." (cl-typep x 'kmacro-function)) (cl-defmethod cl-print-object ((object kmacro-function) stream) - (princ "#" stream))) + (princ ")" stream))) (defun kmacro-bind-to-key (_arg) "When not defining or executing a macro, offer to bind last macro to a key.