From: Stefan Monnier Date: Sat, 25 Dec 2021 04:50:31 +0000 (-0500) Subject: fcr.el (fcr-lambda): Change calling convention X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f21b0935a0fd4c6186b1c1a5d95c2c792ff07a06;p=emacs.git fcr.el (fcr-lambda): Change calling convention * lisp/emacs-lisp/fcr.el (fcr-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 f6643c14546..bc5978efb47 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))) - (fcr-lambda cl--generic-nnm () (&rest cnm-args) + (fcr-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/fcr.el b/lisp/emacs-lisp/fcr.el index 77baec8630b..2d19f07ab04 100644 --- a/lisp/emacs-lisp/fcr.el +++ b/lisp/emacs-lisp/fcr.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 FCRs might be useful: +;; Here are some cases of "callable objects" where FCRs 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). +;; - FCR 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 FCRs 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 fcr-lambda (type fields args &rest body) +(defmacro fcr-lambda (type-and-slots args &rest body) "Define anonymous FCR function. -TYPE should be an FCR 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 FCR 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 `fcr-defstruct' 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 (fcr--class-slots class)) (slotbinds (mapcar (lambda (slot) (list (cl--slot-descriptor-name slot))) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 36f9a0514a2..9f61b2f40cf 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 ,(fcr-lambda advice ((where :around)) (&rest args) + `((:around ,(fcr-lambda (advice (where :around)) (&rest args) (apply car cdr args))) - (:before ,(fcr-lambda advice ((where :before)) (&rest args) + (:before ,(fcr-lambda (advice (where :before)) (&rest args) (apply car args) (apply cdr args))) - (:after ,(fcr-lambda advice ((where :after)) (&rest args) + (:after ,(fcr-lambda (advice (where :after)) (&rest args) (apply cdr args) (apply car args))) - (:override ,(fcr-lambda advice ((where :override)) (&rest args) + (:override ,(fcr-lambda (advice (where :override)) (&rest args) (apply car args))) - (:after-until ,(fcr-lambda advice ((where :after-until)) (&rest args) + (:after-until ,(fcr-lambda (advice (where :after-until)) (&rest args) (or (apply cdr args) (apply car args)))) - (:after-while ,(fcr-lambda advice ((where :after-while)) (&rest args) + (:after-while ,(fcr-lambda (advice (where :after-while)) (&rest args) (and (apply cdr args) (apply car args)))) - (:before-until ,(fcr-lambda advice ((where :before-until)) (&rest args) + (:before-until ,(fcr-lambda (advice (where :before-until)) (&rest args) (or (apply car args) (apply cdr args)))) - (:before-while ,(fcr-lambda advice ((where :before-while)) (&rest args) + (:before-while ,(fcr-lambda (advice (where :before-while)) (&rest args) (and (apply car args) (apply cdr args)))) - (:filter-args ,(fcr-lambda advice ((where :filter-args)) (&rest args) + (:filter-args ,(fcr-lambda (advice (where :filter-args)) (&rest args) (apply cdr (funcall car args)))) - (:filter-return ,(fcr-lambda advice ((where :filter-return)) (&rest args) + (:filter-return ,(fcr-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 FCR) where FCR is a \"prototype\" diff --git a/lisp/kmacro.el b/lisp/kmacro.el index b6779db3076..af13ebbb01d 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. - (fcr-lambda kmacro-function ((mac (if counter (list mac counter format) mac))) + (fcr-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.