scratch/oclosure fe5457ff75 19/25: oclosure.el (oclosure-lambda): Change calling convention

[Stefan Monnier]

branch: scratch/oclosure
commit fe5457ff757ded7999610917f8f39d28b8908e6f
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    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.
---
 lisp/emacs-lisp/cl-generic.el |  2 +-
 lisp/emacs-lisp/nadvice.el    | 20 ++++++++++----------
 lisp/emacs-lisp/oclosure.el   | 29 +++++++++++++++++------------
 lisp/kmacro.el                |  6 +++---
 4 files changed, 31 insertions(+), 26 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 1886f309e3..46fd2de484 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 3a1c4a2a58..d49ac5ae25 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 b88d108853..d957236fa4 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 93a93a461b..89df60f190 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 "#<kmacro " stream)
+  (princ "#f(kmacro " stream)
   (require 'macros)
   (declare-function macros--insert-vector-macro "macros" (definition))
   (pcase-let ((`(,vecdef ,counter ,format)
@@ -856,7 +856,7 @@ If kbd macro currently being defined end it before 
activating it."
     (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.