* 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.
(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)))))
;; 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:
(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)))
;;;; 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\"
;; 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)))
(cl-typep x 'kmacro-function))
(cl-defmethod cl-print-object ((object kmacro-function) stream)
- (princ "#<kmacro " stream)
+ (princ "#f(kmacro " stream)
(require 'macros)
(declare-function macros--insert-vector-macro "macros" (definition))
(pcase-let ((`(,vecdef ,counter ,format)
(prin1 counter stream)
(princ " " stream)
(prin1 format 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.
projects / emacs.git / commitdiff