Some improvements for cl-flet

Some improvements for cl-flet

[akater]

[-- Attachment #1: Type: text/plain, Size: 3758 bytes --]

I've implemented some fixes for ~cl-flet~ necessary to address an issue
with ~cl-generic~ but also improving ~cl-flet~ proper.  Before I post
the patch, I'd like to clarify one issue.

~cl-flet~'s ~(func exp)~ syntax, as described and implemented, is
incompatible with ~flet~ syntax as specified in Common Lisp.  Namely,
~(func exp)~ syntax does not allow to distinguish between a form ~exp~
returning a function and an arglist ~exp~ for a function ~func~ that
always returns ~nil~.

Consider the following valid (but stylistically poor) Common Lisp code:
#+begin_src lisp :wrap example lisp
(flet ((f #'g))
  (f t t))
#+end_src

#+RESULTS:
#+begin_example lisp
NIL
#+end_example

If I understand the purpose of ~cl-lib~ correctly, corresponding
~cl-flet~ form should return ~nil~ as well.  However, it errors:
#+begin_src emacs-lisp :results code :wrap example emacs-lisp
(condition-case err (cl-flet ((f #'g))
                      (f t t))
  (t err))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(void-function g)
#+end_example

In case it's not clear what's going on: the previous example is
equivalent to the following one, only with ~function~, ~g~ replaced with
~x~, ~y~ correspondingly:
#+begin_src lisp :wrap example lisp
(flet ((f (x y)))
  (f t t))
#+end_src

#+RESULTS:
#+begin_example lisp
NIL
#+end_example

but due to ~(func exp)~ syntax, ~(x y)~ is presumed to be a form meant
to return a function, rather than an arglist, and so
#+begin_src emacs-lisp :results code :wrap example emacs-lisp
(condition-case err (cl-flet ((f (x y)))
                      (f t t))
  (t err))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(void-function x)
#+end_example

The syntax of ~flet~ could only be compatible with ~cl-flet~'s ~(func
exp)~ syntax when ~exp~ is presumed to be a non-list.  For example,
~exp~ could be a symbol.

The following expression could also be unambiguously interpreted in
style of ~(func exp)~ because ~nil~ is not a valid function argument:
#+begin_src emacs-lisp :results code :wrap example emacs-lisp
(cl-flet ((f (lambda nil nil)))
  (f))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
nil
#+end_example

However I don't think it's worth it to use complicated rules to
distinguish such cases.  ~flet~ just has its own syntax, incompatible
with the (Scheme-inspired, likely) idea of binding a function to a
variable.  Such complications would keep ~cl-flet~ unfit for use in
macroexpanded (and otherwise generated) code.  Last but not least,
~(flet ((f (lambda nil nil))) (f))~, etc., is not a valid Common Lisp
code.

Note also that the following is valid (and stylistically fine) Common
Lisp code:
#+begin_src lisp :wrap example lisp
(flet ((f ()))
  (f))
#+end_src

#+RESULTS:
#+begin_example lisp
NIL
#+end_example

However, evaluating corresponding ~cl-flet~ form errors:
#+begin_src emacs-lisp :results code :wrap example emacs-lisp
(condition-case err (cl-flet ((f ()))
                      (f))
  (t err))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(void-function nil)
#+end_example

Finally, note that (an equivalent) ~(func exp)~ syntax could not be
adopted by at all by ~cl-macrolet~, as macrolet forms support
destructuring lambda lists.  For example, the following is a valid (but
stylistically poor) Common Lisp code:
#+begin_src lisp :wrap example lisp
(macrolet ((f (lambda () 'x)))
  (f t nil (t t)))
#+end_src

#+RESULTS:
#+begin_example lisp
NIL
#+end_example

Given all this, I think ~(func exp)~ should be dropped from ~cl-flet~.
My patch (already discussed with Stefan Monnier to some extent)
introduces function ~cl--expand-flet~ which retains the functionality
currently provided by ~(func exp)~, in an unambiguous way.  I suggest to
move it there, away from ~cl-flet~.

Do you agree?

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

Re: Some improvements for cl-flet

[Michael Heerdegen]

Hello akater,

I'm having problems to understand what you want to do and why.

I see that a binding like (f (x y z)) is ambiguous.  But isn't that a
minor problem?  Who ever wants to define a local function that always
just returns nil?  Ok, it can happen, very rarely, but then

  (f (x y z) nil)

works and is much better readable.

> Given all this, I think ~(func exp)~ should be dropped from ~cl-flet~.

And I don't understand why this minor annoyance justifies such a radical
measure, unless I misread that.  I'm often using that syntax.

> My patch (already discussed with Stefan Monnier to some extent)
> introduces function ~cl--expand-flet~ which retains the functionality
> currently provided by ~(func exp)~, in an unambiguous way.  I suggest to
> move it there, away from ~cl-flet~.

Now I'm even more confused: do you suggest to factor the code somehow?

Or would I have to use `cl--expand-flet' instead of `cl-flet' in the
future to get the same behavior as now?  That would be strange.

Sorry if I'm missing something.  It would be helpful to see a patch or
some code, even if it is just a draft.


Michael.

Re: Some improvements for cl-flet

[akater]

[-- Attachment #1: Type: text/plain, Size: 2632 bytes --]

Michael Heerdegen <michael_heerdegen@web.de> writes:

> I'm having problems to understand what you want to do and why.

1. To understand which variation of the patch I should post.

2. Hopefully to convince someone that this (func exp) was a terrible
idea.

> I see that a binding like (f (x y z)) is ambiguous.  But isn't that a
> minor problem?

No.  Syntax ambiguity is always a huge inconvenience.

- If the purpose of cl-lib is to provide a compatibility layer for CL,
  then this is simply not compatible, on top of being ambiguous.

- Such irregularities make code harder to port.

- Such irregularities make it harder to write code programmatically.
  (This also addresses the argument about readability and why would
  anyone write code like this.)

- Last but not least, such irregularities introduce a non-technical
  problem: whether something should be ported to cl-... as is, or a
  degree of artistic freedom is allowed.  If yes, to which extent?  Is
  it worth it to waste everyone's time arguing about each such instance
  in the future and synchronizing their perception?  I'm absolutely
  certain it's not worth it.  The sole point of standards is to be
  followed and thus remain reliable.  Unless they can't be followed for
  technical reasons, in which case it should be noted that those are
  actually limitations, hopefully to be lifted one day.

> And I don't understand why this minor annoyance justifies such a radical
> measure, unless I misread that.

If anything, it's actually (func exp) that is a radical departure from
flet semantics.  I do my best at offering my arguments but in fact it is
one introducing something that is both (!) ambiguous and incompatible
with CL who has (OK, had; it's too late for me now) the burden of proof.

> would I have to use `cl--expand-flet' instead of `cl-flet' in the
> future to get the same behavior as now?

It depends.  Sometimes it's better to use let.  Sometimes, like in our
case with cl-generic, an expander is the most appropriate.

> That would be strange.

With all due respect, I do not accept “strange” for an argument and I
never offer such arguments myself.  “Strange” is subjective.  cl-flet is
incompatible with flet (and rest of the points) --- that's objective.

Even if I fail at convincing anyone that it should be dropped, I do
wonder if this was indeed a Scheme influence.

I conveyed all the reasons I could.  If it's not convincing enough,
there is no point in discussing this further, and I'll soon post a
variation of the patch that keeps this syntax in cl-flet as is.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

Re: Some improvements for cl-flet

[Stefan Monnier]

> - If the purpose of cl-lib is to provide a compatibility layer for CL,
>   then this is simply not compatible, on top of being ambiguous.

That statement is true, but it doesn't apply here because the purpose of
cl-lib is not really to provide a compatibility layer for CL (even less
so than the old `cl.el`, since all the identifiers are different due
their `cl-` prefix).


        Stefan

Re: Some improvements for cl-flet

[Michael Heerdegen]

akater <nuclearspace@gmail.com> writes:

> > I see that a binding like (f (x y z)) is ambiguous.  But isn't that a
> > minor problem?
>
> No.  Syntax ambiguity is always a huge inconvenience.

I see your point.  OTOH, removing the expression syntax case would be a
backward incompatible change potentially break existing code - right?

> Even if I fail at convincing anyone that it should be dropped, I do
> wonder if this was indeed a Scheme influence.

A code example (to illustrate what cases we talk about) could look like:

#+begin_src emacs-lisp
(cl-flet ((multilinep (apply-partially #'string-match-p "\n")))
  (pcase something
    ((and (pred stringp) (pred multilinep)) ...)
    ...))
#+end_src

It's useful to be able to bind the result of some expression to a
symbol's function binding.  AFAIR I was one of those who wanted
`cl-flet' to support this, and I had not been inspired by Scheme much.

Personally I wouldn't mind when this functionality would be provided by
some other form, but there is backward compatibility.  And don't you
think that cl-lib (see Stefan's answer) differs from CL much more in
other aspects?

You can find discussions about to which degree cl-lib should be kept an
as strict as possible emulation of Common Lisp in the emacs dev and/or
bug mailing lists.  There were different opinions.  Undoubtedly the main
purpose of cl-lib today is just for writing Emacs Lisp code, however.

Michael.

Re: Some improvements for cl-flet

[Stefan Monnier]

> (cl-flet ((multilinep (apply-partially #'string-match-p "\n")))
>   (pcase something
>     ((and (pred stringp) (pred multilinep)) ...)
>     ...))

FWIW, this is better written as

    (cl-flet ((multilinep (s) (string-match-p "\n" s)))
      ...)

which is both shorter and more efficient.  But there are other cases
where the "simple" form of `cl-flet` is more efficient and the CL
version would need to be of the form

    (flet ((FOO (&rest args) (apply BAR args)))
      ...)

or worse

    (let ((bar (BAR BAZ))
      (flet ((FOO (&rest args) (apply bar args)))
        ...)

which would introduce a significant inefficiency and which can be
difficult for the compiler to optimize back to the efficiency of the
code that our `cl-flet` gets without any effort.

Its true that our `cl-flet` introduces an incompatibility with CL's
semantics, but I considered that it's sufficiently minor that the
tradeoff is worth it (as compared to introducing a separate new form).


        Stefan

[PATCH] Some improvements for cl-flet

[akater]

[-- Attachment #1: Type: text/plain, Size: 6675 bytes --]

Sorry, it took longer than I expected, partially due to my desire to “do
everything right” the first time.

* Issues with cl-flet
There are several issues with ~cl-flet~.

** No error on illegal function names
#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(macroexpand-1 `(cl-flet ((nil () t))
                  (funcall nil)))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(let*
    ((--cl-nil--
      (cl-function
       (lambda nil t))))
  (progn
    (funcall nil)))
#+end_example

#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(macroexpand-1 `(cl-flet (((f) () t))
                  (funcall (f))))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(let*
    ((--cl-\(f\)--
      (cl-function
       (lambda nil t))))
  (progn
    (funcall
     (f))))
#+end_example

** No error on malformed specs
#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(macroexpand-1 `(cl-flet ((f arglist yet-more))))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(let*
    ((--cl-f--
      (cl-function
       (lambda arglist yet-more))))
  (progn))
#+end_example

#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(macroexpand-1 `(cl-flet ((f))))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(let*
    ((--cl-f--
      (cl-function
       (lambda))))
  (progn))
#+end_example

** Incorrectly treated (setf ..) local functions This will attempt to
use a (non-existent, in this case) global function instead of the
generated local one:

#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(macroexpand-1
 `(cl-flet (((setf kar) (new cons) (setf (car cons) new)))
    (let ((cons (cons nil nil)))
      (setf (kar cons) t)
      cons)))
#+end_src

It would be nice to have a support for local setf functions, as in
Common Lisp.

** No warning on duplicated definitions
#+begin_src emacs-lisp :tangle no :results raw :wrap quote
(macroexpand-1 `(cl-flet ((f (x) (1+ x))
                          (f (x) x))
                  (f 42)))
(or (get-buffer "*Warnings*")
    "No warnings")
#+end_src

#+RESULTS:
#+begin_quote
No warnings
#+end_quote

** No warning on unused definitions
#+begin_src emacs-lisp :tangle no :results raw :wrap quote
(macroexpand-1 `(cl-flet ((f (x) x))
                  nil))
(or (get-buffer "*Warnings*")
    "No warnings")
#+end_src

#+RESULTS:
#+begin_quote
No warnings
#+end_quote

Unused definitions better be simply removed from the macroexpanded
code.

** No way to capture definitions present in the body
This is relevant for fixing an issue with ~cl--generic-lambda~: it needs
to record the used definitions; right now it parses with an expensive
and unreliable procedure.  The issue was discussed with Stefan Monnier
at https://lists.gnu.org/archive/html/emacs-devel/2021-09/msg00092.html
and we agreed it's best to alter ~cl-flet~ to record the actually
encountered definitions during macroexpansion.

* Patch overview
The attached patch fixes all of the above.

Note: Supporting local (setf ..) functions requires significantly more
code.  However, I think it's worth it and I hope it gets accepted.

Issue: I tried to alias ~cl--generic-with-memoization~ to
~cl--with-memoization~ but that failed at build time.  For a working
prototype, I just duplicate the definition.  The macro itself is
exactly the same.

Re: capture definitions present in the body,
I decided that simply collecting the actually encountered definitions
during macroexpansion and returning the list would be too ad-hoc so I
implemented expander that could evaluate arbitrary user-provided code
during macroexpansion.  Said code should be provided as 0-argument
lambdas; they are only executed once; the return value is then memoized
and reused during macroexpansion.  The table of memoized values is used
to report the “missing” and “duplicate” warnings.

In a nutshell,
#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(macroexpand-1 `(cl-flet ((f (x y) do f stuff)
                          (g expr))
                  body))
#+end_src

now amounts to
#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(cl--expand-flet macroexpand-all-environment body
  'g (lambda () (list nil expr))
  'f (lambda () (list (make-symbol (format "--cl-%s--" 'f))
                      `(cl-function (lambda (x y) do f stuff)))))
#+end_src

The first element of the returned list indicates whether the second
element should be bound to a local variable, or substituted as is.
There is no lighter alternative as type of expr may vary significantly,
particularly due to keeping the (func exp) syntax for c~l-flet~.

We could use cons rather than list for values but this way, return
values can be employed as let bindings as is.

It might be worth it to make lambdas accept arguments passed to local
functions in the body of ~cl-flet~ and make them run each time.  I found
this interface and the corresponding implementation too cumbersome and
not worth it in the absence of specific applications.  One possible such
application might be found in FIXME entry from =cl-generic.el=:
#+begin_example emacs-lisp
;; FIXME: Optimize the case where call-next-method is
;; only called with explicit arguments.
#+end_example

but I'm not sure I'm correct.

The new implementation of ~cl-flet~ can be macroexpanded with
~macroexpand-1~ just like the old one, so everything is compatible at
this level as well:

#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(cl-values
 (macroexpand-1 `(cl--flet/new ((f (x y) (+ x y)))
                   (f 1 2)))
 (macroexpand-1 `(cl--flet/old ((f (x y) (+ x y)))
                   (f 1 2))))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
((let*
     ((--cl-f--
       (cl-function
        (lambda
          (x y)
          (+ x y)))))
   (funcall --cl-f-- 1 2))
 (let*
     ((--cl-f--
       (cl-function
        (lambda
          (x y)
          (+ x y)))))
   (progn
     (funcall --cl-f-- 1 2))))
#+end_example

See the links below for ≈50 examples and tests in Org markup,
for general feel of what the patch does and what I've checked.

* External Links
- [[https://framagit.org/akater/elisp-cl-flet-improvement/-/raw/master/cl-flet-improvement.org?inline=true][for EWW and org-mode (recommended; see Tests section)]]
- [[https://framagit.org/akater/elisp-cl-flet-improvement/-/blob/master/cl-flet-improvement.org#L295][for other browsers]]

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

Re: [PATCH] Some improvements for cl-flet

[akater]

[-- Attachment #1: Type: text/plain, Size: 54 bytes --]

And here's the actual patch which I forgot to supply.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: cl-flet improvements --]
[-- Type: text/x-diff, Size: 20822 bytes --]

From 2f045c0043de702cda8bb686635b393a2ff9f2d8 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Tue, 21 Sep 2021 23:14:12 +0000
Subject: [PATCH] * lisp/emacs-lisp/cl-macs.el (cl-flet): Improved definition

Fixes the following issues with cl-flet:
- No error on illegal function names
- No error on malformed specs
- Incorrectly treated (setf ..) local functions
- No warning on duplicated definitions
- No warning on unused definitions
- No way to capture definitions present in the body

* lisp/emacs-lisp/cl-generic.el (cl--generic-with-memoization):
Move definition to cl-macs
* lisp/emacs-lisp/cl-macs.el
(cl--expand-flet): New function for more robust cl-flet definition and
more featureful expansion
(cl--with-memoization): Move definition from cl-generic
(cl--flet-convert-with-setf, cl--valid-function-name-symbol-p,
cl--check-function-name, cl--valid-let-symbol-p,
cl--call-flet-expander, cl--expand-local-setf): New function to
accomodate cl--expand-flet
(with--cl-flet-macroexp): New macro to accomodate cl--expand-flet
(cl--flet-convert-with-setf-cache, cl--local-setf-expanders): New
variable to accomodate cl--expand-flet
---
 lisp/emacs-lisp/cl-generic.el |  12 +-
 lisp/emacs-lisp/cl-macs.el    | 335 +++++++++++++++++++++++++++++++---
 2 files changed, 317 insertions(+), 30 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 1640975b84..39e38e29fa 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -98,7 +98,7 @@
 ;; usually be simplified, or even completely skipped.
 
 (eval-when-compile (require 'cl-lib))
-(eval-when-compile (require 'cl-macs))  ;For cl--find-class.
+(eval-when-compile (require 'cl-macs))  ;For cl--find-class, with-memoization.
 (eval-when-compile (require 'pcase))
 
 (cl-defstruct (cl--generic-generalizer
@@ -589,7 +589,7 @@ defalias sym 'dummy))   ;Record definition into load-history.
         ;; e.g. for tracing/debug-on-entry.
         (defalias sym gfun)))))
 
-(defmacro cl--generic-with-memoization (place &rest code)
+(defmacro cl--with-memoization (place &rest code)
   (declare (indent 1) (debug t))
   (gv-letplace (getter setter) place
     `(or ,getter
@@ -601,7 +601,7 @@ defmacro cl--generic-with-memoization (place &rest code)
 (defvar cl--generic-dispatchers (make-hash-table :test #'equal))
 
 (defun cl--generic-get-dispatcher (dispatch)
-  (cl--generic-with-memoization
+  (cl--with-memoization
       (gethash dispatch cl--generic-dispatchers)
     ;; (message "cl--generic-get-dispatcher (%S)" dispatch)
     (let* ((dispatch-arg (car dispatch))
@@ -647,7 +647,7 @@ defun cl--generic-get-dispatcher (dispatch)
           (let ((method-cache (make-hash-table :test #'eql)))
             (lambda (,@fixedargs &rest args)
               (let ,bindings
-                (apply (cl--generic-with-memoization
+                (apply (cl--with-memoization
                            (gethash ,tag-exp method-cache)
                          (cl--generic-cache-miss
                           generic ',dispatch-arg dispatches-left methods
@@ -691,7 +691,7 @@ defun cl--generic-build-combined-method (generic methods)
       ;; Special case needed to fix a circularity during bootstrap.
       (cl--generic-standard-method-combination generic methods)
     (let ((f
-           (cl--generic-with-memoization
+           (cl--with-memoization
                ;; FIXME: Since the fields of `generic' are modified, this
                ;; hash-table won't work right, because the hashes will change!
                ;; It's not terribly serious, but reduces the effectiveness of
@@ -1140,7 +1140,7 @@ defvar cl--generic-head-used (make-hash-table :test #'eql))
   ;; since we can't use the `head' specializer to implement itself.
   (if (not (eq (car-safe specializer) 'head))
       (cl-call-next-method)
-    (cl--generic-with-memoization
+    (cl--with-memoization
         (gethash (cadr specializer) cl--generic-head-used)
       specializer)
     (list cl--generic-head-generalizer)))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 6d6482c349..ecbe8e86fc 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2004,6 +2004,282 @@ defun cl--labels-convert (f)
           (setq cl--labels-convert-cache (cons f res))
           res))))))
 
+(defvar cl--flet-convert-with-setf-cache nil
+  "Like `cl--labels-convert-cache' but for local setf functions.")
+
+(defun cl--flet-convert-with-setf (f)
+  "Special macro-expander to rename (function F) references in `cl-flet', including (function (setf F)).
+
+See also `cl--labels-convert'."
+  ;; Note: If this function, or `cl--labels-convert', for that matter,
+  ;; is redefined at runtime,
+  ;; the whole replacement mechanism breaks!
+  (if (and (consp f) (eq 'setf (car f)))
+      (cond
+       ;; We repeat lots of code from `cl--labels-convert'
+       ((eq (cadr f) (car cl--flet-convert-with-setf-cache))
+        (cdr cl--flet-convert-with-setf-cache))
+       (t
+        (let* ((found (assoc f macroexpand-all-environment #'equal))
+               (replacement (and found
+                                 (ignore-errors
+                                   (funcall (cdr found) cl--labels-magic)))))
+          (if (and replacement (eq cl--labels-magic (car replacement)))
+              (nth 1 replacement)
+            (let ((res `(function ,f)))
+              (setq cl--flet-convert-with-setf-cache (cons (cadr f) res))
+              res)))))
+    (cl--labels-convert f)))
+
+(defmacro cl--with-memoization (place &rest code)
+  (declare (indent 1) (debug t))
+  (gv-letplace (getter setter) place
+    `(or ,getter
+         ,(macroexp-let2 nil val (macroexp-progn code)
+            `(progn
+               ,(funcall setter val)
+               ,val)))))
+
+(defun cl--valid-function-name-symbol-p (expr)
+  "If expr is a symbol permitted to be a function name, return non-nil.
+
+Otherwise, return nil."
+  (and (symbolp expr) (not (eq t expr)) expr))
+
+(defun cl--check-function-name (expr)
+  "Signal error if EXPR is invalid function name.  Otherwise, return nil."
+  (unless (or (cl--valid-function-name-symbol-p expr)
+              (and (consp expr) (eq 'setf (car expr))
+                   (consp (cdr expr))
+                   (symbolp (cadr expr))
+                   (null (cddr expr))))
+    (error "Illegal function name: %s" expr)))
+
+(defun cl--valid-let-symbol-p (x)
+  "If X is a symbol permitted to be a variable in a let binding, return non-nil.
+
+Otherwise, return nil."
+  ;; Not nil, t, :keywords ---
+  ;; according to error message `Attempt to set a constant symbol' from `let'
+  ;; and description of SYMBOL_CONSTANT_P in data.c.
+  ;;
+  ;; Unfortunately we can't use symbol-constant-p directly.
+  (and (symbolp x) (not (or (null x) (eq t x) (keywordp x)))))
+
+(defun cl--call-flet-expander (expander function-name)
+  "Call flet expander EXPANDER for local function FUNCTION-NAME,
+checking return value type."
+  (let ((binding-or-pseudo-binding (funcall expander)))
+    (unless (and (consp binding-or-pseudo-binding)
+                 (or (cl--valid-let-symbol-p (car binding-or-pseudo-binding))
+                     (null (car binding-or-pseudo-binding)))
+                 (consp (cdr binding-or-pseudo-binding))
+                 (null (cddr binding-or-pseudo-binding)))
+      (error "cl--expand-flet expander %s for local function %s returns illegal value: %s"
+             expander function-name binding-or-pseudo-binding))
+    binding-or-pseudo-binding))
+
+(defmacro with--cl-flet-macroexp ( arglist var
+                                   function-name expander memoized-alist
+                                   &rest body)
+  "Return lambda (with ARGLIST being its arglist) that can
+serve as a macroexpanding function in
+`macroexpand-all-environment' to expand local function calls of
+the form (FUNCTION-NAME ..).
+
+The body of lambda will be BODY, with variable named VAR
+implicitly bound to the return value of flet-expander EXPANDER,
+retreived from the place MEMOIZED-ALIST if possible, and saved in
+the place MEMOIZED-ALIST otherwise.
+
+MEMOIZED-ALIST is presumed to refer to an alist."
+  (declare (indent 5))
+  (unless (proper-list-p arglist)
+    (error "Arglist is not a proper list: %s" arglist))
+  (unless (cl--valid-let-symbol-p var)
+    (error "Can't be a `let' variable: %s" var))
+  `(lambda ,arglist
+     (let ((,var
+            (let ((return-value
+                   (cl--with-memoization (alist-get ,function-name
+                                                    ,memoized-alist
+                                                    nil nil #'equal)
+                     (cl--call-flet-expander ,expander ,function-name))))
+              (if (null (car return-value)) (cadr return-value)
+                (car return-value)))))
+       ,@body)))
+
+(defvar cl--local-setf-expanders nil
+  "Holds expanders for local non-generic setf functions.
+
+Holds the same data as flet-expanders-plist argument to
+`cl--expand-flet', only this one is alist and its keys are F
+rather than (setf F).")
+
+(defun cl--expand-local-setf (&rest places-and-values)
+  "Expand `(setf . ,PLACES-AND-VALUES)
+according to `cl--local-setf-expanders'.
+
+Presumes the caller has `macroexpand-all-environment' bound."
+  (macroexp-progn
+   (cl-loop
+    for cons on places-and-values by #'cddr
+    for (place new) on places-and-values by #'cddr
+    as expander = nil
+    if (null (cdr cons))
+    do (error "Odd number of arguments to setf: %s"
+              (cons 'setf places-and-values))
+    else collect
+    (cond ((or (not (consp place))
+               ;; Do not override local macros.
+               (assq (car place) macroexpand-all-environment))
+           (macroexpand-all
+            (macroexpand-1 `(setf ,place ,new)
+                           (remove '(setf . cl--expand-local-setf)
+                                   macroexpand-all-environment))
+            macroexpand-all-environment))
+          ((progn
+             (unless (proper-list-p (cdr place))
+               (error "Malformed place: %s" place))
+             (setq expander
+                   (alist-get (car place) cl--local-setf-expanders
+                              nil nil #'eq)))
+           (funcall expander place new))
+          (t
+           (macroexpand-all
+            (macroexpand-1 `(setf ,place ,new)
+                           (remove '(setf . cl--expand-local-setf)
+                                   macroexpand-all-environment))
+            macroexpand-all-environment))))))
+
+(defun cl--expand-flet (env body &rest flet-expanders-plist)
+  "Return a form equivalent to `(cl-flet ,bindings BODY)
+where bindings correspond to FLET-EXPANDERS-PLIST as described below.
+
+ENV should be macroexpansion environment
+to be augmented with some definitions from FLET-EXPANDERS-PLIST
+to then expand forms in BODY with.
+
+FLET-EXPANDERS-PLIST should be a plist
+where keys are function names
+and values are 0-argument lambdas
+to be called if the corresponding function name is encountered
+in BODY and then only (that is, at most once).
+
+The return value of said lambdas should be either
+
+- a valid let-binding (SYMBOL function) to be used in let*
+  bindings over BODY so that SYMBOL could be used in place of the
+  corresponding function name in BODY
+
+or
+
+- a list (NIL EXPR) for EXPR to be used in BODY in place of the
+  corresponding function name as is.
+
+In case several identical function names are specified in
+FLET-EXPANDERS-PLIST, the first one is used
+(and a warning is issued).
+
+Note: ENV is not used as is, but is copied."
+  (declare (indent 2))
+  (let ((cl--local-setf-expanders cl--local-setf-expanders) memoized-setf
+        memoized all-names)
+    (cl-loop
+     for cons on flet-expanders-plist by #'cddr
+     for (function-name expander) on flet-expanders-plist by #'cddr
+     if (null (cdr cons))
+     do (error "Odd number of arguments to cl--expand-flet: %s"
+               (apply #'list 'cl--expand-flet env body flet-expanders-plist))
+     else
+     do (cl--check-function-name function-name)
+     ;; TODO: Maybe allow t as a pseudo-function-name
+     ;; for unconditional code execution during macroexpansion.
+     (unless (cl-typep expander 'function)
+       (signal 'wrong-type-argument
+               (list 'function expander 'expander)))
+     (let ((seen (assoc function-name all-names
+                        ;; Here and after, names may be symbols or conses.
+                        #'equal)))
+       (if seen (cl-symbol-macrolet ((warned (cdr seen)))
+                  (unless warned
+                    (warn "Duplicate local function definition: %s"
+                          function-name)
+                    (setf warned t)))
+         (push (cons function-name nil) all-names)
+         ;; The last definition should be the effectual one.
+         ;; Our implementation presumes
+         ;; `cl--expand-flet' lists entries in reverse order
+         ;; compared to `cl-flet'.
+         ;; This makes implementations of `cl--expand-flet', `cl-flet' simpler
+         ;; while the difference in the interface
+         ;; only matters for incorrect or stylistically bad code
+         ;; so it shouldn't bother us.
+         (let ((f function-name)
+               ;; Don't capture loop's vars in lambdas below
+               ;; returned by `with--cl-flet-macroexp'.
+               (thunk expander))
+           (if (not (and (consp function-name)
+                         (eq 'setf (car function-name))))
+               (push (cons function-name
+                           (with--cl-flet-macroexp (&rest args) var
+                                                   f thunk memoized
+                             (if (eq (car args) cl--labels-magic)
+                                 (list cl--labels-magic var)
+                               `(funcall ,var ,@args))))
+                     env)
+             (push (cons (cadr function-name)
+                         (with--cl-flet-macroexp (place new) var
+                                                 f thunk memoized-setf
+                           ;; `gv' does the same but a gv-based implementation
+                           ;; we could think of required advising function-get
+                           ;; and advising is ugly.
+                           ;; This is also more CL-self-contained.
+                           (let ((new-gensym (let ((gensym-counter 0))
+                                               (gensym "setf-arg-")))
+                                 setf-args)
+                             `(let (,@(let ((gensym-counter 1))
+                                        (mapcar
+                                         (lambda (arg)
+                                           (let ((gensym
+                                                  (gensym "setf-arg-")))
+                                             (push gensym setf-args)
+                                             (list gensym arg)))
+                                         (cdr place)))
+                                    (,new-gensym ,new))
+                                (funcall ,var ,new-gensym
+                                         ,@(nreverse setf-args))))))
+                   cl--local-setf-expanders)
+             (push (cons function-name
+                         (with--cl-flet-macroexp (&rest _args) var
+                                                 f thunk
+                                                 ;; TODO: memoized?
+                                                 memoized-setf
+                           (list cl--labels-magic var)))
+                   ;; This is meant solely for `cl--flet-convert-with-setf'.
+                   env))))))
+    (let* ((macroexpanded-body
+            (let ((newenv (cons '(setf . cl--expand-local-setf) env)))
+              ;; TODO: Get rid of the newenv binding
+              ;; if the order of 'function and 'setf
+              ;; in the `macroxpand-all-environment' is not essential.
+              (macroexpand-all (macroexp-progn body)
+                               (if (assq 'function newenv) newenv
+                                 (cons (cons 'function
+                                             #'cl--flet-convert-with-setf)
+                                       newenv)))))
+           (memoized (nconc memoized memoized-setf))
+           (binds
+            ;; Preserve cdrs to use nset-difference below.
+            (mapcar #'cdr memoized)))
+      (dolist (missing (cl-nset-difference all-names memoized
+                                           :key #'car :test #'equal))
+        (warn "Local function defined but is missing in body: %s"
+              (car missing)))
+      (macroexp-let* (cl-delete nil binds :key #'car :test #'eq)
+                     macroexpanded-body))))
+
+
 ;;;###autoload
 (defmacro cl-flet (bindings &rest body)
   "Make local function definitions.
@@ -2027,30 +2303,41 @@ defmacro cl-flet (bindings &rest body)
                                         [&optional ("interactive" interactive)]
                                         def-body)])
                    cl-declarations body)))
-  (let ((binds ()) (newenv macroexpand-all-environment))
-    (dolist (binding bindings)
-      (let ((var (make-symbol (format "--cl-%s--" (car binding))))
-            (args-and-body (cdr binding)))
-        (if (and (= (length args-and-body) 1) (symbolp (car args-and-body)))
-            ;; Optimize (cl-flet ((fun var)) body).
-            (setq var (car args-and-body))
-          (push (list var (if (= (length args-and-body) 1)
-                              (car args-and-body)
-                            `(cl-function (lambda . ,args-and-body))))
-                binds))
-	(push (cons (car binding)
-                    (lambda (&rest args)
-                      (if (eq (car args) cl--labels-magic)
-                          (list cl--labels-magic var)
-                        `(funcall ,var ,@args))))
-              newenv)))
-    ;; FIXME: Eliminate those functions which aren't referenced.
-    (macroexp-let* (nreverse binds)
-                   (macroexpand-all
-                    `(progn ,@body)
-                    ;; Don't override lexical-let's macro-expander.
-                    (if (assq 'function newenv) newenv
-                      (cons (cons 'function #'cl--labels-convert) newenv))))))
+  (apply #'cl--expand-flet macroexpand-all-environment body
+         (let (flet-expanders-plist)
+           (dolist (binding bindings flet-expanders-plist)
+             (let (function-name args-and-body)
+               (unless (and (consp binding)
+                            (proper-list-p
+                             (setq args-and-body (cdr binding)))
+                            args-and-body)
+                 (error "The flet definition spec %s is malformed" binding))
+               ;; Function name will be checked for correctness by expand-flet.
+               ;; TODO: Consider checking it right here to error earlier.
+               (setq function-name (car binding))
+               ;; TODO: We push a quoted lambda form;
+               ;; maybe it's better to push a closure?
+               (push `(lambda ()
+                        ,(or (and (null (cdr args-and-body))
+                                  (symbolp (car args-and-body))
+                                  `(list nil ',(car args-and-body)))
+                             (progn
+                               (unless (listp (car args-and-body))
+                                 (error "The lambda expression has a non-list lambda-list: %s"
+                                        (cons 'lambda args-and-body)
+                                        ;; TODO: When implicit cl-block is implemented, change this to
+                                        ;; `(lambda ,(car args-and-body)
+                                        ;;    (cl-block ,function-name ,@(cdr args-and-body)))
+                                        ;; for consistency.
+                                        ))
+                               `(list (make-symbol
+                                       (format "--cl-%s--" ',function-name))
+                                      (list 'cl-function
+                                            (cons 'lambda
+                                                  ;; TODO: Implement implicit cl-block
+                                                  ',args-and-body))))))
+                     flet-expanders-plist)
+               (push function-name flet-expanders-plist))))))
 
 ;;;###autoload
 (defmacro cl-flet* (bindings &rest body)
-- 
2.32.0

Re: [PATCH] Some improvements for cl-flet

[João Távora]

Can I add my 2c here, since we're talking about cl-flet?

cl-flet is near to useless in elisp for a silly reason: indentation.
I end up doing

(let ((bla (lambda (x)
             (* x x))))
  ...
  (funcall bla 42)
  ...)

Because that has correct indentation.  This is useless,
especially with longer local function names.  Same with cl-labels
of course.

(cl-flet ((bla (x)
               (* x x)))
  ...
  (bla 42)
  ...)

I so very wish _that_ could be addressed,  Akater :-)

João

Re: [PATCH] Some improvements for cl-flet, and some more

[akater]

[-- Attachment #1.1: Type: text/plain, Size: 120 bytes --]

I don't feel confindent at all when editing or even reading Emacs
indentation code but here you go, this seems to work.

[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Maybe fix cl-flet indentation --]
[-- Type: text/x-diff, Size: 2981 bytes --]

From b3105ee7e08ee76f06773ee61ef7bbc264dfefc7 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Fri, 24 Sep 2021 15:04:47 +0000
Subject: [PATCH] Indent bodies of local function definitions properly in
 elisp-mode

* lisp/emacs-lisp/lisp-mode.el (lisp-indent-function): Check for local
defforms
(lisp--local-defform-body): New auxiliary function
---
 lisp/emacs-lisp/lisp-mode.el | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index eac3c03cd1..b9bfba60b1 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -29,6 +29,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
 
 (defvar font-lock-comment-face)
 (defvar font-lock-doc-face)
@@ -1105,6 +1106,26 @@ defun calculate-lisp-indent (&optional parse-start)
               (t
                normal-indent))))))
 
+(defun lisp--local-defform-body (state)
+  "Return non-nil if at local definition body according to STATE.
+
+STATE is the `parse-partial-sexp' state for current position."
+  (when-let ((start-of-innermost-containing-list (nth 1 state)))
+    (let* ((parents (nth 9 state)) second-order-parent
+           (second-cons-after (cddr parents)))
+      (while second-cons-after
+        (when (= start-of-innermost-containing-list
+                 (car second-cons-after))
+          (setq second-order-parent (car parents)
+                ;; Leave the loop.
+                second-cons-after nil))
+        (pop second-cons-after) (pop parents))
+      (and second-order-parent
+           (save-excursion
+             (goto-char (1+ second-order-parent))
+             (memq (read (current-buffer))
+                   '(cl-flet cl-labels)))))))
+
 (defun lisp-indent-function (indent-point state)
   "This function is the normal value of the variable `lisp-indent-function'.
 The function `calculate-lisp-indent' calls this to determine
@@ -1138,7 +1159,8 @@ defun lisp-indent-function (indent-point state)
     (if (and (elt state 2)
              (not (looking-at "\\sw\\|\\s_")))
         ;; car of form doesn't seem to be a symbol
-        (progn
+        (if (lisp--local-defform-body state)
+            (lisp-indent-defform state indent-point)
           (if (not (> (save-excursion (forward-line 1) (point))
                       calculate-lisp-indent-last-sexp))
 		(progn (goto-char calculate-lisp-indent-last-sexp)
@@ -1160,7 +1182,9 @@ defun lisp-indent-function (indent-point state)
 	(cond ((or (eq method 'defun)
 		   (and (null method)
 			(> (length function) 3)
-			(string-match "\\`def" function)))
+			(string-match "\\`def" function))
+                   ;; Check whether we are in flet or labels.
+                   (lisp--local-defform-body state))
 	       (lisp-indent-defform state indent-point))
 	      ((integerp method)
 	       (lisp-indent-specform method state
-- 
2.32.0

Re: [PATCH] Some improvements for cl-flet, and some more

[João Távora]

On Fri, Sep 24, 2021 at 4:31 PM akater <nuclearspace@gmail.com> wrote:
>
> I don't feel confindent at all when editing or even reading Emacs
> indentation code

Hehe, that's more than understood! Only for the brave!

> but here you go, this seems to work.

Awesome, thanks! I will certainly give it a try!

João

Re: [PATCH] Some improvements for cl-flet

[akater]

[-- Attachment #1.1: Type: text/plain, Size: 145 bytes --]

I was sloppy when distinguishing local macros and local functions; the
new patch addresses this.  Also, lost comment about lexical-let is back.


[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: cl-flet improvement, fix local macro detection --]
[-- Type: text/x-diff, Size: 22787 bytes --]

From 8e09771472e7a25ed7cbe500e09a23b2e34ed394 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Tue, 21 Sep 2021 23:14:12 +0000
Subject: [PATCH] * lisp/emacs-lisp/cl-macs.el (cl-flet): Improved definition

Fixes the following issues with cl-flet:
- No error on illegal function names
- No error on malformed specs
- Incorrectly treated (setf ..) local functions
- No warning on duplicated definitions
- No warning on unused definitions
- No way to capture definitions present in the body

* lisp/emacs-lisp/cl-generic.el (cl--generic-with-memoization):
Move definition to cl-macs
* lisp/emacs-lisp/cl-macs.el
(cl--expand-flet): New function for more robust cl-flet definition and
more featureful expansion
(cl--with-memoization): Move definition from cl-generic
(cl--flet-convert-with-setf, cl--valid-function-name-symbol-p,
cl--check-function-name, cl--valid-let-symbol-p,
cl--call-flet-expander, cl--expand-local-setf): New function to
accomodate cl--expand-flet
(with--cl-flet-macroexp): New macro to accomodate cl--expand-flet
(cl--flet-convert-with-setf-cache, cl--local-setf-expanders): New
variable to accomodate cl--expand-flet
---
 lisp/emacs-lisp/cl-generic.el |  12 +-
 lisp/emacs-lisp/cl-macs.el    | 379 +++++++++++++++++++++++++++++++---
 2 files changed, 361 insertions(+), 30 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 1640975b84..39e38e29fa 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -98,7 +98,7 @@
 ;; usually be simplified, or even completely skipped.
 
 (eval-when-compile (require 'cl-lib))
-(eval-when-compile (require 'cl-macs))  ;For cl--find-class.
+(eval-when-compile (require 'cl-macs))  ;For cl--find-class, with-memoization.
 (eval-when-compile (require 'pcase))
 
 (cl-defstruct (cl--generic-generalizer
@@ -589,7 +589,7 @@ defalias sym 'dummy))   ;Record definition into load-history.
         ;; e.g. for tracing/debug-on-entry.
         (defalias sym gfun)))))
 
-(defmacro cl--generic-with-memoization (place &rest code)
+(defmacro cl--with-memoization (place &rest code)
   (declare (indent 1) (debug t))
   (gv-letplace (getter setter) place
     `(or ,getter
@@ -601,7 +601,7 @@ defmacro cl--generic-with-memoization (place &rest code)
 (defvar cl--generic-dispatchers (make-hash-table :test #'equal))
 
 (defun cl--generic-get-dispatcher (dispatch)
-  (cl--generic-with-memoization
+  (cl--with-memoization
       (gethash dispatch cl--generic-dispatchers)
     ;; (message "cl--generic-get-dispatcher (%S)" dispatch)
     (let* ((dispatch-arg (car dispatch))
@@ -647,7 +647,7 @@ defun cl--generic-get-dispatcher (dispatch)
           (let ((method-cache (make-hash-table :test #'eql)))
             (lambda (,@fixedargs &rest args)
               (let ,bindings
-                (apply (cl--generic-with-memoization
+                (apply (cl--with-memoization
                            (gethash ,tag-exp method-cache)
                          (cl--generic-cache-miss
                           generic ',dispatch-arg dispatches-left methods
@@ -691,7 +691,7 @@ defun cl--generic-build-combined-method (generic methods)
       ;; Special case needed to fix a circularity during bootstrap.
       (cl--generic-standard-method-combination generic methods)
     (let ((f
-           (cl--generic-with-memoization
+           (cl--with-memoization
                ;; FIXME: Since the fields of `generic' are modified, this
                ;; hash-table won't work right, because the hashes will change!
                ;; It's not terribly serious, but reduces the effectiveness of
@@ -1140,7 +1140,7 @@ defvar cl--generic-head-used (make-hash-table :test #'eql))
   ;; since we can't use the `head' specializer to implement itself.
   (if (not (eq (car-safe specializer) 'head))
       (cl-call-next-method)
-    (cl--generic-with-memoization
+    (cl--with-memoization
         (gethash (cadr specializer) cl--generic-head-used)
       specializer)
     (list cl--generic-head-generalizer)))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 6d6482c349..c626d26a1a 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2004,6 +2004,326 @@ defun cl--labels-convert (f)
           (setq cl--labels-convert-cache (cons f res))
           res))))))
 
+(defvar cl--flet-convert-with-setf-cache nil
+  "Like `cl--labels-convert-cache' but for local setf functions.")
+
+(defun cl--flet-convert-with-setf (f)
+  "Special macro-expander to rename (function F) references in `cl-flet', including (function (setf F)).
+
+See also `cl--labels-convert'."
+  ;; Note: If this function, or `cl--labels-convert', for that matter,
+  ;; is redefined at runtime,
+  ;; the whole replacement mechanism breaks!
+  (if (and (consp f) (eq 'setf (car f)))
+      (cond
+       ;; We repeat lots of code from `cl--labels-convert'
+       ((eq (cadr f) (car cl--flet-convert-with-setf-cache))
+        (cdr cl--flet-convert-with-setf-cache))
+       (t
+        (let* ((found (assoc f macroexpand-all-environment #'equal))
+               (replacement (and found
+                                 (ignore-errors
+                                   (funcall (cdr found) cl--labels-magic)))))
+          (if (and replacement (eq cl--labels-magic (car replacement)))
+              (nth 1 replacement)
+            (let ((res `(function ,f)))
+              (setq cl--flet-convert-with-setf-cache (cons (cadr f) res))
+              res)))))
+    (cl--labels-convert f)))
+
+(defmacro cl--with-memoization (place &rest code)
+  (declare (indent 1) (debug t))
+  (gv-letplace (getter setter) place
+    `(or ,getter
+         ,(macroexp-let2 nil val (macroexp-progn code)
+            `(progn
+               ,(funcall setter val)
+               ,val)))))
+
+(defun cl--valid-function-name-symbol-p (expr)
+  "If expr is a symbol permitted to be a function name, return non-nil.
+
+Otherwise, return nil."
+  (and (symbolp expr) (not (eq t expr)) expr))
+
+(defun cl--check-function-name (expr)
+  "Signal error if EXPR is invalid function name.  Otherwise, return nil."
+  (unless (or (cl--valid-function-name-symbol-p expr)
+              (and (consp expr) (eq 'setf (car expr))
+                   (consp (cdr expr))
+                   (symbolp (cadr expr))
+                   (null (cddr expr))))
+    (error "Illegal function name: %s" expr)))
+
+(defun cl--valid-let-symbol-p (x)
+  "If X is a symbol permitted to be a variable in a let binding, return non-nil.
+
+Otherwise, return nil."
+  ;; Not nil, t, :keywords ---
+  ;; according to error message `Attempt to set a constant symbol' from `let'
+  ;; and description of SYMBOL_CONSTANT_P in data.c.
+  ;;
+  ;; Unfortunately we can't use symbol-constant-p directly.
+  (and (symbolp x) (not (or (null x) (eq t x) (keywordp x)))))
+
+(defun cl--call-flet-expander (expander function-name)
+  "Call flet expander EXPANDER for local function FUNCTION-NAME,
+checking return value type."
+  (let ((binding-or-pseudo-binding (funcall expander)))
+    (unless (and (consp binding-or-pseudo-binding)
+                 (or (cl--valid-let-symbol-p (car binding-or-pseudo-binding))
+                     (null (car binding-or-pseudo-binding)))
+                 (consp (cdr binding-or-pseudo-binding))
+                 (null (cddr binding-or-pseudo-binding)))
+      (error "cl--expand-flet expander %s for local function %s returns illegal value: %s"
+             expander function-name binding-or-pseudo-binding))
+    binding-or-pseudo-binding))
+
+(defmacro with--cl-flet-macroexp ( arglist var
+                                   function-name expander memoized-alist
+                                   &rest body)
+  "Return lambda (with ARGLIST being its arglist) that can
+serve as a macroexpanding function in
+`macroexpand-all-environment' to expand local function calls of
+the form (FUNCTION-NAME ..).
+
+The body of lambda will be BODY, with variable named VAR
+implicitly bound to the return value of flet-expander EXPANDER,
+retreived from the place MEMOIZED-ALIST if possible, and saved in
+the place MEMOIZED-ALIST otherwise.
+
+MEMOIZED-ALIST is presumed to refer to an alist."
+  (declare (indent 5))
+  (unless (proper-list-p arglist)
+    (error "Arglist is not a proper list: %s" arglist))
+  (unless (cl--valid-let-symbol-p var)
+    (error "Can't be a `let' variable: %s" var))
+  `(lambda ,arglist
+     (let ((,var
+            (let ((return-value
+                   (cl--with-memoization (alist-get ,function-name
+                                                    ,memoized-alist
+                                                    nil nil #'equal)
+                     (cl--call-flet-expander ,expander ,function-name))))
+              (if (null (car return-value)) (cadr return-value)
+                (car return-value)))))
+       ,@body)))
+
+(defvar cl--local-setf-expanders nil
+  "Holds expanders for local non-generic setf functions.
+
+Holds the same data as flet-expanders-plist argument to
+`cl--expand-flet', only this one is alist and its keys are F
+rather than (setf F).")
+
+(defconst cl--flet-bottom (list (make-symbol "cl--flet-bottom"))
+  "A constant value to put at the bottom of all cl-flet environments,
+to distinguish local macros from local functions.
+
+We use a singleton list rather than a symbol solely so that
+procedures that presume `macroexpand-all-environment' to be alist
+wouldn't freak out.")
+
+(defun cl--local-macro-p (symbol)
+  "Return non-nil iff SYMBOL is bound to a local macro in `macroexpand-all-environment'.
+
+SYMBOL is presumed to be a symbol.
+
+True returned value will be SYMBOL's binding in
+`macroexpand-all-environment'."
+  (let ((subenv macroexpand-all-environment) result cl-flet)
+    (while subenv
+      (let ((binding (pop subenv)))
+        (cond ((equal '(setf . cl--expand-local-setf) binding)
+               (setq cl-flet t))
+              ((eq cl--flet-bottom binding)
+               (setq cl-flet nil))
+              ((and (consp binding) (eq symbol (car binding)))
+               (setq subenv nil
+                     result (unless cl-flet binding))))))
+    result))
+
+(defun cl--expand-local-setf (&rest places-and-values)
+  "Expand `(setf . ,PLACES-AND-VALUES)
+according to `cl--local-setf-expanders'.
+
+Presumes the caller has `macroexpand-all-environment' bound."
+  (macroexp-progn
+   (cl-loop
+    for cons on places-and-values by #'cddr
+    for (place new) on places-and-values by #'cddr
+    as expander = nil
+    if (null (cdr cons))
+    do (error "Odd number of arguments to setf: %s"
+              (cons 'setf places-and-values))
+    else collect
+    (cond ((or (not (consp place))
+               (progn
+                 (unless (symbolp (car place))
+                   (error "Malformed place: %s" place))
+                 (cl--local-macro-p (car place))
+                 ;; TODO: If we're here we can likely use the returned binding
+                 ;; to macroexpand-1 our setf manually.
+                 ))
+           (macroexpand-all
+            (macroexpand-1 `(setf ,place ,new)
+                           (remove '(setf . cl--expand-local-setf)
+                                   macroexpand-all-environment))
+            macroexpand-all-environment))
+          ((progn
+             (unless (proper-list-p (cdr place))
+               (error "Malformed place: %s" place))
+             (setq expander
+                   (alist-get (car place) cl--local-setf-expanders
+                              nil nil #'eq)))
+           ;; TODO: Shouldn't we
+           ;; (macroexpand-all (funcall expander place new)
+           ;;                  macroexpand-all-environment)
+           ;; as well?
+           (funcall expander place new))
+          (t
+           (macroexpand-all
+            (macroexpand-1 `(setf ,place ,new)
+                           (remove '(setf . cl--expand-local-setf)
+                                   macroexpand-all-environment))
+            macroexpand-all-environment))))))
+
+(defun cl--expand-flet (env body &rest flet-expanders-plist)
+  "Return a form equivalent to `(cl-flet ,bindings BODY)
+where bindings correspond to FLET-EXPANDERS-PLIST as described below.
+
+ENV should be macroexpansion environment
+to be augmented with some definitions from FLET-EXPANDERS-PLIST
+to then expand forms in BODY with.
+
+FLET-EXPANDERS-PLIST should be a plist
+where keys are function names
+and values are 0-argument lambdas
+to be called if the corresponding function name is encountered
+in BODY and then only (that is, at most once).
+
+The return value of said lambdas should be either
+
+- a valid let-binding (SYMBOL function) to be used in let*
+  bindings over BODY so that SYMBOL could be used in place of the
+  corresponding function name in BODY
+
+or
+
+- a list (NIL EXPR) for EXPR to be used in BODY in place of the
+  corresponding function name as is.
+
+In case several identical function names are specified in
+FLET-EXPANDERS-PLIST, the first one is used
+(and a warning is issued).
+
+Note: ENV is not used as is, but is copied."
+  (declare (indent 2))
+  (let ((cl--local-setf-expanders cl--local-setf-expanders) memoized-setf
+        memoized all-names)
+    (push cl--flet-bottom env)
+    (cl-loop
+     for cons on flet-expanders-plist by #'cddr
+     for (function-name expander) on flet-expanders-plist by #'cddr
+     if (null (cdr cons))
+     do (error "Odd number of arguments to cl--expand-flet: %s"
+               (apply #'list 'cl--expand-flet env body flet-expanders-plist))
+     else
+     do (cl--check-function-name function-name)
+     ;; TODO: Maybe allow t as a pseudo-function-name
+     ;; for unconditional code execution during macroexpansion.
+     (unless (cl-typep expander 'function)
+       (signal 'wrong-type-argument
+               (list 'function expander 'expander)))
+     (let ((seen (assoc function-name all-names
+                        ;; Here and after, names may be symbols or conses.
+                        #'equal)))
+       (if seen (cl-symbol-macrolet ((warned (cdr seen)))
+                  (unless warned
+                    (warn "Duplicate local function definition: %s"
+                          function-name)
+                    (setf warned t)))
+         (push (cons function-name nil) all-names)
+         ;; The last definition should be the effectual one.
+         ;; Our implementation presumes
+         ;; `cl--expand-flet' lists entries in reverse order
+         ;; compared to `cl-flet'.
+         ;; This makes implementations of `cl--expand-flet', `cl-flet' simpler
+         ;; while the difference in the interface
+         ;; only matters for incorrect or stylistically bad code
+         ;; so it shouldn't bother us.
+         (let ((f function-name)
+               ;; Don't capture loop's vars in lambdas below
+               ;; returned by `with--cl-flet-macroexp'.
+               (thunk expander))
+           (if (not (and (consp function-name)
+                         (eq 'setf (car function-name))))
+               (push (cons function-name
+                           (with--cl-flet-macroexp (&rest args) var
+                                                   f thunk memoized
+                             (if (eq (car args) cl--labels-magic)
+                                 (list cl--labels-magic var)
+                               `(funcall ,var ,@args))))
+                     env)
+             (push (cons (cadr function-name)
+                         (with--cl-flet-macroexp (place new) var
+                                                 f thunk memoized-setf
+                           ;; `gv' does the same but a gv-based implementation
+                           ;; we could think of required advising function-get
+                           ;; and advising is ugly.
+                           ;; This is also more CL-self-contained.
+                           (let ((new-gensym (let ((gensym-counter 0))
+                                               (gensym "setf-arg-")))
+                                 setf-args)
+                             `(let (,@(let ((gensym-counter 1))
+                                        (mapcar
+                                         (lambda (arg)
+                                           (let ((gensym
+                                                  (gensym "setf-arg-")))
+                                             (push gensym setf-args)
+                                             (list gensym arg)))
+                                         (cdr place)))
+                                    (,new-gensym ,new))
+                                (funcall ,var ,new-gensym
+                                         ,@(nreverse setf-args))))))
+                   cl--local-setf-expanders)
+             (push (cons function-name
+                         (with--cl-flet-macroexp (&rest _args) var
+                                                 f thunk
+                                                 ;; TODO: memoized?
+                                                 memoized-setf
+                           (list cl--labels-magic var)))
+                   ;; This is meant solely for `cl--flet-convert-with-setf'.
+                   env))))))
+    (let* ((macroexpanded-body
+            (let ((newenv (cons '(setf . cl--expand-local-setf)
+                                ;; This cons also serves to indicate
+                                ;; that cl-flet environment starts here
+                                ;; in `cl--local-macro-p'.
+                                ;; In other words, it serves as cl--flet-top.
+                                ;; TODO: Consider defining it as constant.
+                                env)))
+              ;; TODO: Get rid of the newenv binding
+              ;; if the order of 'function and 'setf
+              ;; in the `macroxpand-all-environment' is not essential.
+              (macroexpand-all (macroexp-progn body)
+                               ;; Don't override lexical-let's macro-expander.
+                               (if (assq 'function newenv) newenv
+                                 (cons (cons 'function
+                                             #'cl--flet-convert-with-setf)
+                                       newenv)))))
+           (memoized (nconc memoized memoized-setf))
+           (binds
+            ;; Preserve cdrs to use nset-difference below.
+            (mapcar #'cdr memoized)))
+      (dolist (missing (cl-nset-difference all-names memoized
+                                           :key #'car :test #'equal))
+        (warn "Local function defined but is missing in body: %s"
+              (car missing)))
+      (macroexp-let* (cl-delete nil binds :key #'car :test #'eq)
+                     macroexpanded-body))))
+
+
 ;;;###autoload
 (defmacro cl-flet (bindings &rest body)
   "Make local function definitions.
@@ -2027,30 +2347,41 @@ defmacro cl-flet (bindings &rest body)
                                         [&optional ("interactive" interactive)]
                                         def-body)])
                    cl-declarations body)))
-  (let ((binds ()) (newenv macroexpand-all-environment))
-    (dolist (binding bindings)
-      (let ((var (make-symbol (format "--cl-%s--" (car binding))))
-            (args-and-body (cdr binding)))
-        (if (and (= (length args-and-body) 1) (symbolp (car args-and-body)))
-            ;; Optimize (cl-flet ((fun var)) body).
-            (setq var (car args-and-body))
-          (push (list var (if (= (length args-and-body) 1)
-                              (car args-and-body)
-                            `(cl-function (lambda . ,args-and-body))))
-                binds))
-	(push (cons (car binding)
-                    (lambda (&rest args)
-                      (if (eq (car args) cl--labels-magic)
-                          (list cl--labels-magic var)
-                        `(funcall ,var ,@args))))
-              newenv)))
-    ;; FIXME: Eliminate those functions which aren't referenced.
-    (macroexp-let* (nreverse binds)
-                   (macroexpand-all
-                    `(progn ,@body)
-                    ;; Don't override lexical-let's macro-expander.
-                    (if (assq 'function newenv) newenv
-                      (cons (cons 'function #'cl--labels-convert) newenv))))))
+  (apply #'cl--expand-flet macroexpand-all-environment body
+         (let (flet-expanders-plist)
+           (dolist (binding bindings flet-expanders-plist)
+             (let (function-name args-and-body)
+               (unless (and (consp binding)
+                            (proper-list-p
+                             (setq args-and-body (cdr binding)))
+                            args-and-body)
+                 (error "The flet definition spec %s is malformed" binding))
+               ;; Function name will be checked for correctness by expand-flet.
+               ;; TODO: Consider checking it right here to error earlier.
+               (setq function-name (car binding))
+               ;; TODO: We push a quoted lambda form;
+               ;; maybe it's better to push a closure?
+               (push `(lambda ()
+                        ,(or (and (null (cdr args-and-body))
+                                  (symbolp (car args-and-body))
+                                  `(list nil ',(car args-and-body)))
+                             (progn
+                               (unless (listp (car args-and-body))
+                                 (error "The lambda expression has a non-list lambda-list: %s"
+                                        (cons 'lambda args-and-body)
+                                        ;; TODO: When implicit cl-block is implemented, change this to
+                                        ;; `(lambda ,(car args-and-body)
+                                        ;;    (cl-block ,function-name ,@(cdr args-and-body)))
+                                        ;; for consistency.
+                                        ))
+                               `(list (make-symbol
+                                       (format "--cl-%s--" ',function-name))
+                                      (list 'cl-function
+                                            (cons 'lambda
+                                                  ;; TODO: Implement implicit cl-block
+                                                  ',args-and-body))))))
+                     flet-expanders-plist)
+               (push function-name flet-expanders-plist))))))
 
 ;;;###autoload
 (defmacro cl-flet* (bindings &rest body)
-- 
2.32.0

Re: [PATCH] Some improvements for cl-flet, and some more

[Lars Ingebrigtsen]

akater <nuclearspace@gmail.com> writes:

> I don't feel confindent at all when editing or even reading Emacs
> indentation code but here you go, this seems to work.

I gave the patch a go, and it does indeed fix this long-standing problem
(see bug#9622), and after testing a while, I can't see any adverse
effects, so I went ahead and pushed it to Emacs 28 (with some whitespace
changes, a test and a NEWS entry).

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Re: [PATCH] Some improvements for cl-flet, and some more

[João Távora]

Boy, did I get my money's worth out of those 2c.
Thanks Akater and Lars!
João

Re: [PATCH] Some improvements for cl-flet

[Lars Ingebrigtsen]

akater <nuclearspace@gmail.com> writes:

> Fixes the following issues with cl-flet:
> - No error on illegal function names
> - No error on malformed specs
> - Incorrectly treated (setf ..) local functions
> - No warning on duplicated definitions
> - No warning on unused definitions
> - No way to capture definitions present in the body

Sounds great.  :-)  I don't have any comments on the actual
functionality, but just a couple of trivial notes:

> -(defmacro cl--generic-with-memoization (place &rest code)
> +(defmacro cl--with-memoization (place &rest code)

Is there any reason for this renaming?

> +(defun cl--flet-convert-with-setf (f)
> +  "Special macro-expander to rename (function F) references in `cl-flet', including (function (setf F)).

The first line of the doc string should be a complete sentence (shorter
than 80 characters).

> +(defmacro with--cl-flet-macroexp ( arglist var
> +                                   function-name expander memoized-alist
> +                                   &rest body)
> +  "Return lambda (with ARGLIST being its arglist) that can
> +serve as a macroexpanding function in
> +`macroexpand-all-environment' to expand local function calls of
> +the form (FUNCTION-NAME ..).

Ditto (and the same for a couple more macros).

Anyway, this sounds like good improvement for cl-flet, but I think it'll
have to wait until Emacs 29 -- it's a too big a change to go into Emacs
28.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Re: [PATCH] Some improvements for cl-flet

[akater]

[-- Attachment #1: Type: text/plain, Size: 827 bytes --]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Is there any reason for this renaming?

cl-generic depends on cl-macs (at compile time) and defines this
memoization macro.  Since I use the macro in cl-macs, it makes sense to
just move the definition to cl-macs.  However, build failed when I tried
to do this so for a working prototype, I submitted the closest
approximation that does build.

> The first line of the doc string should be a complete sentence (shorter
> than 80 characters).

Missed those, will fix after functionality is reviewed.

> Anyway, this sounds like good improvement for cl-flet, but I think it'll
> have to wait until Emacs 29 -- it's a too big a change to go into Emacs
> 28.

Just curious: is there a policy not to introduce too many changes per
release?  My patch is backwards compatible, after all.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

Re: [PATCH] Some improvements for cl-flet

[Lars Ingebrigtsen]

akater <nuclearspace@gmail.com> writes:

> cl-generic depends on cl-macs (at compile time) and defines this
> memoization macro.  Since I use the macro in cl-macs, it makes sense to
> just move the definition to cl-macs.  However, build failed when I tried
> to do this so for a working prototype, I submitted the closest
> approximation that does build.

Right.

> Just curious: is there a policy not to introduce too many changes per
> release?  My patch is backwards compatible, after all.

No, but we're close to cutting the emacs-28 branch, and we'd rather not
introduce anything that changes anything low-level at this point.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Re: [PATCH] Some improvements for cl-flet

[Stefan Monnier]

Hi,

Sorry for taking so long to review this.
This looks very complex for a macro that's used rather rarely.
Maybe it might be worthwhile splitting it into 2 or 3 patches so as to
better see how we got to the level of complexity.
See more comments below.

> --- a/lisp/emacs-lisp/cl-generic.el

I skipped this since `with-memoization` is now in `subr-x`.

> diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
> index 6d6482c349..ecbe8e86fc 100644
> --- a/lisp/emacs-lisp/cl-macs.el
> +++ b/lisp/emacs-lisp/cl-macs.el
> @@ -2004,6 +2004,282 @@ defun cl--labels-convert (f)
>            (setq cl--labels-convert-cache (cons f res))
>            res))))))
>  
> +(defvar cl--flet-convert-with-setf-cache nil
> +  "Like `cl--labels-convert-cache' but for local setf functions.")
> +
> +(defun cl--flet-convert-with-setf (f)
> +  "Special macro-expander to rename (function F) references in `cl-flet', including (function (setf F)).
> +
> +See also `cl--labels-convert'."
> +  ;; Note: If this function, or `cl--labels-convert', for that matter,
> +  ;; is redefined at runtime,
> +  ;; the whole replacement mechanism breaks!
> +  (if (and (consp f) (eq 'setf (car f)))
> +      (cond
> +       ;; We repeat lots of code from `cl--labels-convert'
> +       ((eq (cadr f) (car cl--flet-convert-with-setf-cache))
> +        (cdr cl--flet-convert-with-setf-cache))
> +       (t
> +        (let* ((found (assoc f macroexpand-all-environment #'equal))
> +               (replacement (and found
> +                                 (ignore-errors
> +                                   (funcall (cdr found) cl--labels-magic)))))
> +          (if (and replacement (eq cl--labels-magic (car replacement)))
> +              (nth 1 replacement)
> +            (let ((res `(function ,f)))
> +              (setq cl--flet-convert-with-setf-cache (cons (cadr f) res))
> +              res)))))
> +    (cl--labels-convert f)))

I didn't get to the point of trying to understand this.

> +(defmacro with--cl-flet-macroexp ( arglist var
> +                                   function-name expander memoized-alist
> +                                   &rest body)

All the defs should start with "cl-" so it should be `cl--with...`.

> +(defun cl--expand-local-setf (&rest places-and-values)
> +  "Expand `(setf . ,PLACES-AND-VALUES)
> +according to `cl--local-setf-expanders'.
> +
> +Presumes the caller has `macroexpand-all-environment' bound."

Why do we have/need this?  Does it work with other things that use
gv-places, like `push`, `pop`, `cl-callf`, ...?  If so, how?
If not, then we need another approach which does.

I thought handling `cl-flet` of (setf foo) would amount to calling
`gv-setter` to get the symbol corresponding to `(setf foo)` and then
c-flet-binding that symbol instead of `(setf foo).

> +(defun cl--expand-flet (env body &rest flet-expanders-plist)
> +  "Return a form equivalent to `(cl-flet ,bindings BODY)
> +where bindings correspond to FLET-EXPANDERS-PLIST as described below.
> +
> +ENV should be macroexpansion environment
> +to be augmented with some definitions from FLET-EXPANDERS-PLIST
> +to then expand forms in BODY with.
> +
> +FLET-EXPANDERS-PLIST should be a plist
> +where keys are function names
> +and values are 0-argument lambdas
> +to be called if the corresponding function name is encountered
> +in BODY and then only (that is, at most once).

Why "at most once"?

> +The return value of said lambdas should be either
> +
> +- a valid let-binding (SYMBOL function) to be used in let*
> +  bindings over BODY so that SYMBOL could be used in place of the
> +  corresponding function name in BODY
> +
> +or
> +
> +- a list (NIL EXPR) for EXPR to be used in BODY in place of the
> +  corresponding function name as is.

Can we simplify this so only one of the two is supported?


        Stefan

Re: Some improvements for cl-flet

[akater]

[-- Attachment #1: Type: text/plain, Size: 1362 bytes --]


I must leave one more notice.

What will the following forms return, with cl-flet being implemented as is?

(let ((n 0))
  (cl-symbol-macrolet ((f0 (progn (cl-incf n) #'identity)))
    (cl-flet ((f f0))
      (f t) (f t)
      n)))

(let ((n 0))
  (cl-symbol-macrolet ((f0 (progn (cl-incf n) #'identity)))
    (cl-flet ((f (identity f0)))
      (f t) (f t)
      n)))

Turns out, the value is not determined by cl-flet spec but rather by its implementation.  If it is optimized in a certain way (which is the case right now), the values will diverge.

While of course they shouldn't.

> Personally I wouldn't mind when this functionality would be provided by
> some other form, but there is backward compatibility.
>

> Don't you think that cl-lib (see Stefan's answer) differs from CL
> much more in other aspects?

No.  The note was about cl- prefix.  I can often write CL code easily
portable to Elisp and back again by merely writing cl: prefixes in it.
Of course, even without them, porting is trivial.  The ability to share
code is beneficial.  I think we should aim to eliminate the difference
between cl-lib and CL rather than extend it.

> I see your point.  OTOH, removing the expression syntax case would be a
> backward incompatible change potentially break existing code - right?

Introducing it potentially broke existing code in the first place.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

Re: [PATCH] Some improvements for cl-flet

[akater]

[-- Attachment #1: Type: text/plain, Size: 3259 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> Maybe it might be worthwhile splitting it into 2 or 3 patches so as to
> better see how we got to the level of complexity.
> See more comments below.

Local setfs certainly can be added later (or simply dropped, until
better times).  It will simplify the patch.

> Why do we have/need this?  Does it work with other things that use
> gv-places, like `push`, `pop`, `cl-callf`, ...?  If so, how?
> If not, then we need another approach which does.

I added support for local setfs mostly

- because I decided to implement all features of flet since I'm dealing
  with low levels of cl-flet anyway and this might be the last time it
  happens;

- and since ignoring local setfs now might make it harder to implement
  them in future.

This functionality does not have any more to do with places than

(cl-defmethod (setf ..) ..)

so I guess it has no relation to gv-places, right?

>
> I thought handling `cl-flet` of (setf foo) would amount to calling
> `gv-setter` to get the symbol corresponding to `(setf foo)` and then
> c-flet-binding that symbol instead of `(setf foo).
>

At the very least, gv-setter will fail for local (setf car) and so on.
I don't know how cl-flet should treat such things (in Common Lisp it's
UB) but I saw that cl-flet performs local redefinition of car just fine
so I followed suit.

>> +(defun cl--expand-flet (env body &rest flet-expanders-plist)
>> +  "Return a form equivalent to `(cl-flet ,bindings BODY)
>> +where bindings correspond to FLET-EXPANDERS-PLIST as described below.
>> +
>> +ENV should be macroexpansion environment
>> +to be augmented with some definitions from FLET-EXPANDERS-PLIST
>> +to then expand forms in BODY with.
>> +
>> +FLET-EXPANDERS-PLIST should be a plist
>> +where keys are function names
>> +and values are 0-argument lambdas
>> +to be called if the corresponding function name is encountered
>> +in BODY and then only (that is, at most once).
>
> Why "at most once"?

We don't want to end up calling different functions in different
instances of local function calls which share the same name within a
single cl-flet form, for whatever unforseeable reason this might happen
(like poorly written flet-expander or poorly written exp in (func exp)).
The best way to ensure local definitions are consistent is to only
produce the local function once per local function used in the body.

If the local function is not encountered in the body at all, the
corresponding function object (or whatever exp in (func exp) evaluated
to) is never produced.  Hence, “at most once”.

Note also that in the use case this patch was motivated by, we only need
to evaluate arbitrary code once per encountered symbol:

(cl--expand-flet macroenv (cdr parsed-body)
  'cl-call-next-method (lambda () (push cnm uses-cnm)
                         (list nil cnm))
  'cl-next-method-p (lambda () (push nmp uses-cnm)
                      (list nil nmp)))

> Can we simplify this so only one of the two is supported?

Maybe but before I reply properly, I'd like to know if you have any
thoughts on
https://lists.gnu.org/archive/html/emacs-devel/2021-10/msg00522.html
(it is relevant).

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

Re: Some improvements for cl-flet

[Stefan Monnier]

> I must leave one more notice.
>
> What will the following forms return, with cl-flet being implemented as is?
>
> (let ((n 0))
>   (cl-symbol-macrolet ((f0 (progn (cl-incf n) #'identity)))
>     (cl-flet ((f f0))
>       (f t) (f t)
>       n)))
>
> (let ((n 0))
>   (cl-symbol-macrolet ((f0 (progn (cl-incf n) #'identity)))
>     (cl-flet ((f (identity f0)))
>       (f t) (f t)
>       n)))
>
> Turns out, the value is not determined by cl-flet spec but rather by its implementation.

Yup, the same problem affects (pcase f0 ...) and many other
macros.  Luckily symbol macros are rarely used.

>> I see your point.  OTOH, removing the expression syntax case would be a
>> backward incompatible change potentially break existing code - right?
> Introducing it potentially broke existing code in the first place.

In theory yes.  But:
- That's already broken and we can't unbreak it.
- There's been no report of such a case, so it is just be hypothetical
  at this point.
I suggest that if we want to align Common Lisp and `cl-flet`, the better
fix is to improve Common Lisp so it works like `cl-flet` ;-)


        Stefan

Re: [PATCH] Some improvements for cl-flet

[Stefan Monnier]

>> Maybe it might be worthwhile splitting it into 2 or 3 patches so as to
>> better see how we got to the level of complexity.
>> See more comments below.
>
> Local setfs certainly can be added later (or simply dropped, until
> better times).  It will simplify the patch.

I'm fine adding it now, but I'd like to see the intermediate steps to
better understand what is due to what.

>> Why do we have/need this?  Does it work with other things that use
>> gv-places, like `push`, `pop`, `cl-callf`, ...?  If so, how?
>> If not, then we need another approach which does.
>
> I added support for local setfs mostly

I understand why we want support for local setf functions.
My question was why do we need the code I referred to in order to
implement that feature.

The patch below seems to work for me.

>> I thought handling `cl-flet` of (setf foo) would amount to calling
>> `gv-setter` to get the symbol corresponding to `(setf foo)` and then
>> c-flet-binding that symbol instead of `(setf foo).
> At the very least, gv-setter will fail for local (setf car) and so on.
> I don't know how cl-flet should treat such things (in Common Lisp it's
> UB) but I saw that cl-flet performs local redefinition of car just fine
> so I followed suit.

I'd also consider such a (setf car) as UB, but as for how does it behave
in practice: basically `car` has a `gv-expander` and those take
precedence over a (setf car) function.

>>> +(defun cl--expand-flet (env body &rest flet-expanders-plist)
>>> +  "Return a form equivalent to `(cl-flet ,bindings BODY)
>>> +where bindings correspond to FLET-EXPANDERS-PLIST as described below.
>>> +
>>> +ENV should be macroexpansion environment
>>> +to be augmented with some definitions from FLET-EXPANDERS-PLIST
>>> +to then expand forms in BODY with.
>>> +
>>> +FLET-EXPANDERS-PLIST should be a plist
>>> +where keys are function names
>>> +and values are 0-argument lambdas
>>> +to be called if the corresponding function name is encountered
>>> +in BODY and then only (that is, at most once).
>>
>> Why "at most once"?
>
> We don't want to end up calling different functions in different
> instances of local function calls which share the same name within a
> single cl-flet form, for whatever unforseeable reason this might happen
> (like poorly written flet-expander or poorly written exp in (func exp)).

The question is why enforce this here rather than elsewhere.
It restricts the possible uses of `cl--expand-flet` and I get the
impression that it doesn't save us any significant complexity in the
callers (it saves us less complexity there than it costs us here).
E.g. in:

> (cl--expand-flet macroenv (cdr parsed-body)
>   'cl-call-next-method (lambda () (push cnm uses-cnm)
>                          (list nil cnm))
>   'cl-next-method-p (lambda () (push nmp uses-cnm)
>                       (list nil nmp)))

If the functions where called multiple times rather than "at
most once", we'd just replace the `push` with `cl-pushnew`.

But that's a very minor cosmetic detail.  Either way works, I was just
curious why you did it this way.


        Stefan


diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 1852471bcbb..ad0477e3b68 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2030,7 +2030,10 @@ cl-flet
   (let ((binds ()) (newenv macroexpand-all-environment))
     (dolist (binding bindings)
       (let ((var (make-symbol (format "--cl-%s--" (car binding))))
+            (fname (car binding))
             (args-and-body (cdr binding)))
+        (if (eq (car-safe fname) 'setf)
+            (setq fname (gv-setter (cadr fname))))
         (if (and (= (length args-and-body) 1) (symbolp (car args-and-body)))
             ;; Optimize (cl-flet ((fun var)) body).
             (setq var (car args-and-body))
@@ -2038,7 +2041,7 @@ cl-flet
                               (car args-and-body)
                             `(cl-function (lambda . ,args-and-body))))
                 binds))
-	(push (cons (car binding)
+	(push (cons fname
                     (lambda (&rest args)
                       (if (eq (car args) cl--labels-magic)
                           (list cl--labels-magic var)

Re: Some improvements for cl-flet

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

Is there a good reason to support cl-symbol-macrolet at all?
It is a bizarre construct.


-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

Re: Some improvements for cl-flet

[akater]

[-- Attachment #1: Type: text/plain, Size: 604 bytes --]

Richard Stallman <rms@gnu.org> writes:

> Is there a good reason to support cl-symbol-macrolet at all?
> It is a bizarre construct.

People largely agree that with-slots is beneficial, for example.  with-slots
wouldn't be possible without symbol-macrolet.

Both macrolet and symbol-macrolet (and flet as well) are indispensable in
macros.  macrolet is effectively a built-in code-walker and code transformer,
the most powerful functionality accessible to end user in CL and likely in
Elisp as well.  symbol-macrolet is comparable (it can be used to achieve
effects that can't be achieved with macrolet).

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

Re: [PATCH] Some improvements for cl-flet

[akater]

[-- Attachment #1: Type: text/plain, Size: 4509 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> +The return value of said lambdas should be either
>> +
>> +- a valid let-binding (SYMBOL function) to be used in let*
>> +  bindings over BODY so that SYMBOL could be used in place of the
>> +  corresponding function name in BODY
>> +
>> +or
>> +
>> +- a list (NIL EXPR) for EXPR to be used in BODY in place of the
>> +  corresponding function name as is.
>
> Can we simplify this so only one of the two is supported?

There are several ways to simplify this.  Here they go, in the order of
attractiveness (to you, as I perceive it):


a.  When flet-expander returns a symbol, plug it in as is.  If it returns
anything else, use it as initial value in a let binding.

This basically mimics the present mechanism.  It sounds good but the question
is, why are we certain that we'll only ever want to plug in symbols.

Plugging in symbols and symbols only is arbitrary, as my example with
symbol-macrolet demonstrates.  Aren't values of type “compiled-function” worth
injecting directly as well?  Arguably more so since at least they won't
evaluate indefinite number of times with possible side effects.  Same applies
to other constant values that include present or future funcallable objects.
What if expander returns nil or t?  We probably should add exception concerning
those.

Overall, such spec involves guessing and eventually will get more complicated
than what we started with.  Which is why I don't recommend a.


b.  Allow building more let bindings than necessary

As long as we have to distinguish between buliding a let binding and plugging
in an external form as is, our lambda must return values of two distinguishable
types.  We might however unconditionally generate let bindings and use return
values of flet-expanders as corresponding initial values.  As was the case with
“a”, the values don't have to specify gensyms then, and can be used directly
instead.  Note however that this would introduce incompatibility with the
existing code due to presence of (func exp) syntax in cl-flet: it might be that
some code that used to evaluate several times at runtime will only evaluate
once.  I understand that this is deemed unlikely (and I wish this logic could
be applied to make consp return its argument for true --- even though this
would not be not CL-compatible).  Good news is, this would also make cl-flet
with (func exp) more predictable.

So far low-level functions of Emacs that generate Elisp code do try to avoid
building more let bindings than necessary.  In fact, cl-flet itself does this
right now.  IIUC, with native compiler in action, we might not care that much
about minimizing let bindings.  However, cleaner code generation helps with
debugging, and not only debugging macros.

My impression is, lispers generaly don't produce cleaner macroexpanded code
because it would take too much time to write a procedure that does and because
they don't see that much value in clean macroexpansions.  I think they are
valuable enough (which is why I took the time to ensure it in the case as
important as cl-flet).  Also, despite the fact that clean macroexpansions are
not fashionable, complaints about difficulty of debugging macros themselves or
of macroexpanded code, are fairly popular.  Cluttered macroexpansions
contribute to that difficulty.

So I don't recommend b either.

c.  Transfer the relevant information from return type of
code-generating lambdas into arguments' types of expand-flet

c.1  We could introduce another argument that explicitly lists the symbols for
which forms returned by flet-expanders are plugged in and no let bindings are
generated.

c.2  The expanders could be specified as either lambdas, in which case the
return value is used in the flet body as is, or, say, singleton vectors
[lambda] in which case the return value of funcall of the 0th element is used
as let-binding.  Downsides: (c.2.1) it might be worth it to make this decision
late rather than early; (c.2.2) the interface gets more complicated and less
reasonable.

In c.2 I picked vector because it makes it less likely to confuse lambda
expressions with something that should not be evaluated but overall I think
complicating expand-flet is a bad idea anyway.  So I don't recommend c as well.


The proposed return value types, (var value) and (nil value), looked more
straightforward to me than alternatives I could think of.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

Re: Some improvements for cl-flet

[Michael Heerdegen]

akater <nuclearspace@gmail.com> writes:

> People largely agree that with-slots is beneficial, for example.
> with-slots wouldn't be possible without symbol-macrolet.

`thunk-let', a kind of a lazy let, is another example.

Michael.

Re: Some improvements for cl-flet

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > People largely agree that with-slots is beneficial, for example.  with-slots
  > wouldn't be possible without symbol-macrolet.

`with-slots' seems unnecessary to me too -- at least, to implement it
this way.  Why not just bind the local variables to the contents of
the slots, and copy the variables' values back into OBJECT before
exiting?

That would give bad results in some asynchronous operations, where
reading and writing slots may need to be atomic.  But that is a rare
thing to do in Emacs Lisp.  On those rare occasions one could make the
code clear by explicitly accessing the slots.  Is making those rare
occasions' code simpler (by hiding how it works) enough reason to have
`with-slots'?

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

Re: Some improvements for cl-flet

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > Both macrolet and symbol-macrolet (and flet as well) are indispensable in
  > macros.  macrolet is effectively a built-in code-walker and code transformer,
  > the most powerful functionality accessible to end user in CL and likely in
  > Elisp as well.  symbol-macrolet is comparable (it can be used to achieve
  > effects that can't be achieved with macrolet).

I don't see anything problematical about `cl-macrolet'.  But
`cl-symbol-macrolet' is really bizarre -- it undermines fundamental
assumptions of Lisp.

Would you be willing to explain what special effects `cl-symbol-macrolet'
can achieve?

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

Re: Some improvements for cl-flet

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > `thunk-let', a kind of a lazy let, is another example.

Practically speaking, how important is it to access the same variables
as simple variables, rather than using an explicit macro to access them?

I think it is very important to maintain the principle that a
variable's value only holds a sexp, that _seen from Lisp_ accessing or
setting the variable cannot "do" anything.
-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

Re: Some improvements for cl-flet

[Po Lu]

Richard Stallman <rms@gnu.org> writes:

> Practically speaking, how important is it to access the same variables
> as simple variables, rather than using an explicit macro to access them?
>
> I think it is very important to maintain the principle that a
> variable's value only holds a sexp, that _seen from Lisp_ accessing or
> setting the variable cannot "do" anything.

Yes, but SYMBOL-MACROLET is relatively common in Common Lisp programs,
which in itself warrants its inclusion in a Common Lisp emulation
library, IMO.

And it being one of the macros that Common Lisp programmers writing
Emacs customizations often reach for, I hope it will not be deleted.

Plus, the effects of cl-symbol-macrolet will only apply inside BODY, so
it can't do anything to the majority of code that doesn't use it.

Thanks.

Re: Some improvements for cl-flet

[João Távora]

[-- Attachment #1: Type: text/plain, Size: 1078 bytes --]

On Sun, Oct 10, 2021 at 11:46 AM Po Lu <luangruo@yahoo.com> wrote:

> Richard Stallman <rms@gnu.org> writes:
>
> > Practically speaking, how important is it to access the same variables
> > as simple variables, rather than using an explicit macro to access them?
> >
> > I think it is very important to maintain the principle that a
> > variable's value only holds a sexp, that _seen from Lisp_ accessing or
> > setting the variable cannot "do" anything.
>
> Yes, but SYMBOL-MACROLET is relatively common in Common Lisp programs,
> which in itself warrants its inclusion in a Common Lisp emulation
> library, IMO.
>
> And it being one of the macros that Common Lisp programmers writing
> Emacs customizations often reach for, I hope it will not be deleted.


As do I. There's little reason to delete any functions from a Common Lisp
emulation library, IMO.  Emacs Lisp, like any Lisp worth its salt, is a
programmable programming language, one should be to emulate anything
with it, including Lisp idioms that may not be unanimously appreciated.

João

[-- Attachment #2: Type: text/html, Size: 1588 bytes --]

Re: Some improvements for cl-flet

[Stefan Monnier]

> As do I. There's little reason to delete any functions from a Common Lisp
> emulation library, IMO.  Emacs Lisp, like any Lisp worth its salt, is a
> programmable programming language, one should be to emulate anything
> with it, including Lisp idioms that may not be unanimously appreciated.

Symbol macros have their quirks and are better avoided in general, but
occasionally they come in quite handy.  So I think they fall in
a similar category as advice and lots of other sharp edged tools we have
in our toolbox.


        Stefan

RE: [External] : Re: Some improvements for cl-flet

[Drew Adams]

> There's little reason to delete any functions
> from a Common Lisp emulation library, IMO.

FWIW -

I wish we'd remove all those constructs that
are prefixed by `cl-' but aren't involved with
emulating Common Lisp.  Instead, we seem to be
adding to them.  Prefix `cl-' should be only
for stuff that emulates Common Lisp.

Why people add extraneous stuff (however useful
it might be) to the CL libraries, I don't know.

(I'm not talking about simple helper things,
used only to implement things that emulate
Common Lisp.  I'm talking about things added to
the CL libraries but that have nothing to do
with anything in Common Lisp.)

(I hear the refrain now: "That ship has sailed."
But new such boats seem to keep being launched.)

Re: Some improvements for cl-flet

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > Yes, but SYMBOL-MACROLET is relatively common in Common Lisp programs,
  > which in itself warrants its inclusion in a Common Lisp emulation
  > library, IMO.

I am sure you know what you're referring to.  But I am shocked this
would be used frequently.  Can you plesae show me why and how?

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

Re: Some improvements for cl-flet

[João Távora]

[-- Attachment #1: Type: text/plain, Size: 685 bytes --]

On Mon, Oct 11, 2021 at 10:21 PM Richard Stallman <rms@gnu.org> wrote:

>   > Yes, but SYMBOL-MACROLET is relatively common in Common Lisp programs,
>   > which in itself warrants its inclusion in a Common Lisp emulation
>   > library, IMO.
>
> I am sure you know what you're referring to.  But I am shocked this
> would be used frequently.  Can you plesae show me why and how?


I'm not going to answer for Po Lu, but I'll only mention something not yet
said about this form, which is that it is so important to the Common Lisp
language that it's not even a macro, it's one of the fundamental "special
forms" of the language (added sometime in 1988, it seems).

João

[-- Attachment #2: Type: text/html, Size: 1067 bytes --]

Re: Some improvements for cl-flet

[Po Lu]

Richard Stallman <rms@gnu.org> writes:

>   > Yes, but SYMBOL-MACROLET is relatively common in Common Lisp programs,
>   > which in itself warrants its inclusion in a Common Lisp emulation
>   > library, IMO.
>
> I am sure you know what you're referring to.  But I am shocked this
> would be used frequently.  Can you plesae show me why and how?

In Common Lisp, symbol macros are generally not defined at the toplevel
through DEFINE-SYMBOL-MACRO, as the usefulness of symbol macros defined
this way is limited and prone to confusion.  So when a Common Lisp
programmer needs to define a symbol macro, it usually works to use
SYMBOL-MACROLET instead.

Re: Some improvements for cl-flet

[Robin Tarsiger]

Richard Stallman wrote:
>    > Yes, but SYMBOL-MACROLET is relatively common in Common Lisp programs,
>    > which in itself warrants its inclusion in a Common Lisp emulation
>    > library, IMO.
> 
> I am sure you know what you're referring to.  But I am shocked this
> would be used frequently.  Can you plesae show me why and how?

One key category of use is for macros that take a body and want to expose
variable-like places to that body. For instance, there is the with-slots macro
which binds convenience aliases for slots of a CLOS object, so that:

   (with-slots (foo bar) object
     (setf foo bar))

is equivalent to:

   (setf (slot-value object 'foo) (slot-value object 'bar))

and with-slots can be implemented using symbol-macrolet. Alternatively, any
other place where a macro wants to expose a symbol which may or may not be
a local variable proper in every case, while preserving a compatible interface
with the provided body, may use symbol-macrolet to provide this decoupling.

It is much less common to use symbol-macrolet directly in application code,
though once or twice I have seen it used for local constants in a manner
similar to how parameterless C macros are used for constants.

-RTT

Re: Some improvements for cl-flet

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > I'm not going to answer for Po Lu, but I'll only mention something not yet
  > said about this form, which is that it is so important to the Common Lisp
  > language that it's not even a macro, it's one of the fundamental "special
  > forms" of the language (added sometime in 1988, it seems).

That was after my involvement in Common Lisp, so I never heard of it.
However, I think I see why it is a special form rather than a macro.

A macro expands one Lisp expression into another Lisp expression.
Without some way to make a "variable" stand for magic slots, there was
no way to write a macro that would create such variables.  (What would
that macro expand into?)  So they had to make it a built-in execution
feature.

This doesn't mean it is a good feature to have in a language.  It
messes up the language semantics.  In Emacs we have some variables
with magical effects on editing, but as far as Lisp semantics is
concerned they are only variables.

The definition of `cl-symbol-macro' calls `macroexpand'.  The reason
that method is _possible_ is because the magic "variable" is defined
only inside one expression.  But it is still kludgy.

Worse, it operates by putting advice on `macroexpand'.

Code inside Emacs should _never_ create advice!  Never, ever!  Putting
advice on a function makes that function mysterious.  It obfuscates
debugging that function, because it function does something other than
what its code says.

If we are going to have `cl-symbol-macro', it should be rewritten to
bind a hook which `macroexpand' explicitly runs.  The hook does the
same work as the advice, but the call to run the hook is visible in
the code -- not mysterious magic.

From node Advising Named Functions in the Emacs Lisp Reference Manual:

      @code{advice-add} can be useful for altering the behavior of existing calls
    to an existing function without having to redefine the whole function.
    However, it can be a source of bugs, since existing callers to the function may
    assume the old behavior, and work incorrectly when the behavior is changed by
    advice.  Advice can also cause confusion in debugging, if the person doing the
    debugging does not notice or remember that the function has been modified
    by advice.

      For these reasons, advice should be reserved for the cases where you
    cannot modify a function's behavior in any other way.  If it is
    possible to do the same thing via a hook, that is preferable
    (@pxref{Hooks}).  If you simply want to change what a particular key
    does, it may be better to write a new command, and remap the old
    command's key bindings to the new one (@pxref{Remapping Commands}).

      If you are writing code for release, for others to use, try to avoid
    including advice in it.  If the function you want to advise has no
    hook to do the job, please talk with the Emacs developers about adding
    a suitable hook.  Especially, Emacs's own source files should not put
    advice on functions in Emacs.  (There are currently a few exceptions
    to this convention, but we aim to correct them.)  It is generally
    cleaner to create a new hook in @code{foo}, and make @code{bar} use
    the hook, than to have @code{bar} put advice in @code{foo}.

It looks like this is not visible enough.  Perhaps we should put this in
the top node for advising, and make more links to it.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

Re: Some improvements for cl-flet

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > One key category of use is for macros that take a body and want to expose
  > variable-like places to that body. For instance, there is the with-slots macro
  > which binds convenience aliases for slots of a CLOS object, so that:

  >    (with-slots (foo bar) object
  >      (setf foo bar))

Is this small convenience worth complicating the basic semantics of Lisp?
We don't use CLOS very much.

If there is no need for asynchronous atomicity,
with-slots can be implemented with a macro that expands into

   (let ((foo (slot-value object 'foo))
         (bar (slot-value object bar)))
     (unwind-protect
          (setf foo bar)
       (setf (slot-value object 'foo) foo)
       (setf (slot-value object 'bar) bar)))

We can tell people, if you're concerned about atomicity,
access slots by hand.

Adding additional features to a language gives a benefit.  But there
is also a benefit in preserving the things you know can't be happening
in a program.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

Re: Some improvements for cl-flet

[Michael Heerdegen]

akater <nuclearspace@gmail.com> writes:

> > Is there a good reason to support cl-symbol-macrolet at all?
> > It is a bizarre construct.
>
> People largely agree that with-slots is beneficial, for example.
> with-slots wouldn't be possible without symbol-macrolet.

I must say that at first I hated Richard's comments, but now I tend to
agree.

Most of our uses of `symbol-macrolet' are about places.  Like
`with-slots'.  So you can do (setf var expr).

But does the provided syntax have to look exactly like that?  Having
setting a variable change some place as side effect is slightly bizarre
indeed.  We could provide the same feature offering a syntax like

  (setf (place) expr)

where `place' is a local (normal) macro that "returns" a reference to
the according place.  Makes a bit more sense, conceptually.  With other
words: we could provide the same using `cl-macrolet' instead of
`symbol-macrolet'.

The only really different example is `thunk-let', a kind of lazy let I
already mentioned.  But (docstring): "It is not allowed to set
`thunk-let' or `thunk-let*' bound variables."  So there variable
abstraction also doesn't fit so well in that case.

I don't think we should remove `cl-symbol-macrolet', but I have the
impression that all current uses in Emacs could well work without symbol
macros.


Michael.

Re: [PATCH] Some improvements for cl-flet

[akater]

[-- Attachment #1.1: Type: text/plain, Size: 2198 bytes --]

Sorry it took so long; Emacs build broke several times, an on top of
that Org is having some tectonic changes as well, and I've had my own
time trouble.

I tried the following patch.

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> But that's a very minor cosmetic detail.  Either way works, I was just
> curious why you did it this way.
>
>
>         Stefan
>
>
> diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
> index 1852471bcbb..ad0477e3b68 100644
> --- a/lisp/emacs-lisp/cl-macs.el
> +++ b/lisp/emacs-lisp/cl-macs.el
> @@ -2030,7 +2030,10 @@ cl-flet
>    (let ((binds ()) (newenv macroexpand-all-environment))
>      (dolist (binding bindings)
>        (let ((var (make-symbol (format "--cl-%s--" (car binding))))
> +            (fname (car binding))
>              (args-and-body (cdr binding)))
> +        (if (eq (car-safe fname) 'setf)
> +            (setq fname (gv-setter (cadr fname))))
>          (if (and (= (length args-and-body) 1) (symbolp (car args-and-body)))
>              ;; Optimize (cl-flet ((fun var)) body).
>              (setq var (car args-and-body))
> @@ -2038,7 +2041,7 @@ cl-flet
>                                (car args-and-body)
>                              `(cl-function (lambda . ,args-and-body))))
>                  binds))
> -	(push (cons (car binding)
> +	(push (cons fname
>                      (lambda (&rest args)
>                        (if (eq (car args) cl--labels-magic)
>                            (list cl--labels-magic var)

Four of my tests failed which did pass for the solution I've proposed.

The first case is not even supported with global functions in Elisp so
I'm not sure how relevant it is.

Here are the summaries; the rest (results vs expected, some comments) is
attached.  I've received some complaints about my usage of Org markup in
the mailing list so details are omitted from the mail body.

** TEST-FAILED setf with #'(setf ..) in body
** TEST-FAILED non-setf local function within (setf ..) local function
** TEST-FAILED Local setf function within local non-setf function within local setf function
** TEST-FAILED Eponymous local macro, local function and its setf, local macro, local function


[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]

[-- Attachment #2: Failed tests for gv-setter-based implementation of local setfs --]
[-- Type: text/plain, Size: 5434 bytes --]

#+title: Improving cl-flet in Emacs 29: Local setf solution by Stefan Monnier
#+author: =#<PERSON akater A24961DE3ADD04E057ADCF4599555CE6F2E1B21D>=
#+property: header-args :lexical t
#+startup: nologdone show2levels
#+todo: TEST-FAILED(f) | TEST-PASSED(p)

* Definition
#+begin_src emacs-lisp :results none
(defmacro cl-flet (bindings &rest body)
  "Make local function definitions.
Each definition can take the form (FUNC EXP) where
FUNC is the function name, and EXP is an expression that returns the
function value to which it should be bound, or it can take the more common
form (FUNC ARGLIST BODY...) which is a shorthand
for (FUNC (lambda ARGLIST BODY)).

FUNC is defined only within FORM, not BODY, so you can't write
recursive function definitions.  Use `cl-labels' for that.  See
info node `(cl) Function Bindings' for details.

\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
  (declare (indent 1)
           (debug ((&rest [&or (&define name function-form) (cl-defun)])
                   cl-declarations body)))
  (let ((binds ()) (newenv macroexpand-all-environment))
    (dolist (binding bindings)
      (let ((var (make-symbol (format "--cl-%s--" (car binding))))
            (fname (car binding))
            (args-and-body (cdr binding)))
        (if (eq 'setf (car-safe fname))
            (setq fname (gv-setter (cadr fname))))
        (if (and (= (length args-and-body) 1) (symbolp (car args-and-body)))
            ;; Optimize (cl-flet ((fun var)) body).
            (setq var (car args-and-body))
          (push (list var (if (= (length args-and-body) 1)
                              (car args-and-body)
                            `(cl-function (lambda . ,args-and-body))))
                binds))
	(push (cons fname
                    (lambda (&rest args)
                      (if (eq (car args) cl--labels-magic)
                          (list cl--labels-magic var)
                        `(funcall ,var ,@args))))
              newenv)))
    ;; FIXME: Eliminate those functions which aren't referenced.
    (macroexp-let* (nreverse binds)
                   (macroexpand-all
                    `(progn ,@body)
                    ;; Don't override lexical-let's macro-expander.
                    (if (assq 'function newenv) newenv
                      (cons (cons 'function #'cl--labels-convert) newenv))))))
#+end_src

* Tests
** TEST-FAILED setf with #'(setf ..) in body
The difference in ~(let ((setf-arg-0 t)) ..)~ is irrelevant, what's relevant is, ~#'(setf kar)~ is not recognized.
#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(macroexpand-1
 `(cl-flet (((setf kar) (new) 'just-an-example))
    (setf (kar) t)
    (funcall #'(setf kar) t)))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(let*
    ((--cl-\(setf\ kar\)--
      (cl-function
       (lambda
         (new)
         'just-an-example))))
  (progn
    (funcall --cl-\(setf\ kar\)-- t)
    (funcall
     #'(setf kar)
     t)))
#+end_example

#+EXPECTED:
#+begin_example emacs-lisp
(let*
    ((--cl-\(setf\ kar\)--
      (cl-function
       (lambda
         (new)
         'just-an-example))))
  (progn
    (let
        ((setf-arg-0 t))
      (funcall --cl-\(setf\ kar\)-- setf-arg-0))
    (funcall --cl-\(setf\ kar\)-- t)))
#+end_example

** TEST-FAILED non-setf local function within (setf ..) local function
#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(condition-case err
    (let ((x (cons (cons nil nil) nil)))
      (cl-flet ((kar (x) (car x))
                ((setf kar) (new cons) (setf (car cons) new)))
        (setf (kar (kar x)) t))
      x)
  (t err))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(void-function \(setf\ funcall\))
#+end_example

#+EXPECTED:
#+begin_example emacs-lisp
((t))
#+end_example

** TEST-FAILED Local setf function within local non-setf function within local setf function
#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(condition-case err
    (let ((x (cons (cons nil nil) nil))
          (y (cons (cons nil nil) nil)))
      (cl-flet ((kar (x) (car x))
                ((setf kar) (new cons) (setf (car cons) new)))
        (setf (kar (kar (setf (kar y) x))) t))
      (cl-values x y))
  (t err))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(void-function \(setf\ funcall\))
#+end_example

#+EXPECTED:
#+begin_example emacs-lisp
(((t))
 (((t))))
#+end_example

** TEST-FAILED Eponymous local macro, local function and its setf, local macro, local function
#+begin_src emacs-lisp :tangle no :results code :wrap example emacs-lisp
(condition-case err
    (let (result)
      (cl-macrolet ((f (x) ``(f1 ,,x)))
        (push (f 0) result)
        (cl-flet ((f (x) `(f2 ,x))
        ((setf f) (new x) (f (list x new))))
          (push (f 1) result)
          (push (setf (f (f (setf (f 2) 3))) (f 4)) result)
          (cl-macrolet ((f (x) `(car (list `(f3 ,,x)))))
            (push (f 5) result)
            (push (setf (f (f (f 6))) (f 8)) result)
            (cl-flet ((f (x) `(f4 ,x)))
              (push (f 9) result)
              (push (setf (f (f (setf (f 10) 11))) (f 12)) result)))))
      result)
  (t err))
#+end_src

#+RESULTS:
#+begin_example emacs-lisp
(void-function \(setf\ funcall\))
#+end_example

#+EXPECTED:
#+begin_example emacs-lisp
((f1
  ((f4
    (f1
     (10 11)))
   (f4 12)))
 (f4 9)
 (f3 8)
 (f3 5)
 (f1
  ((f2
    (f1
     (2 3)))
   (f2 4)))
 (f2 1)
 (f1 0))
#+end_example

Re: [PATCH] Some improvements for cl-flet

[Stefan Monnier]

> Sorry it took so long; Emacs build broke several times, an on top of
> that Org is having some tectonic changes as well, and I've had my own
> time trouble.

Seeing how slow I am on my side, you have nothing to apologize for.

>> diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
>> index 1852471bcbb..ad0477e3b68 100644
>> --- a/lisp/emacs-lisp/cl-macs.el
>> +++ b/lisp/emacs-lisp/cl-macs.el
>> @@ -2030,7 +2030,10 @@ cl-flet
>>    (let ((binds ()) (newenv macroexpand-all-environment))
>>      (dolist (binding bindings)
>>        (let ((var (make-symbol (format "--cl-%s--" (car binding))))
>> +            (fname (car binding))
>>              (args-and-body (cdr binding)))
>> +        (if (eq (car-safe fname) 'setf)
>> +            (setq fname (gv-setter (cadr fname))))
>>          (if (and (= (length args-and-body) 1) (symbolp (car args-and-body)))
>>              ;; Optimize (cl-flet ((fun var)) body).
>>              (setq var (car args-and-body))
>> @@ -2038,7 +2041,7 @@ cl-flet
>>                                (car args-and-body)
>>                              `(cl-function (lambda . ,args-and-body))))
>>                  binds))
>> -	(push (cons (car binding)
>> +	(push (cons fname
>>                      (lambda (&rest args)
>>                        (if (eq (car args) cl--labels-magic)
>>                            (list cl--labels-magic var)
>
> Four of my tests failed which did pass for the solution I've proposed.

Indeed, I saw some serious problems later on, which basically come down
to the case:

    (cl-flet ((foo FOO)
              ((setf foo) SFOO))
      ...)

where `cl-flet`s definition of `foo` as a macro causes all the
occurrences of (foo ...) inside gv-places to be replaced with (funcall
FOO ...) at which point the connection with (setf foo) is lost.

IIUC you solve this problem by writing your own tree walker, but I'd
*really* much prefer not doing that, and reuse the existing tree walker
in `macroexpand-all`.

> The first case is not even supported with global functions in Elisp so
> I'm not sure how relevant it is.

Indeed #'(setf ..) is currently not supported anywhere, so it's
a separate issue.


        Stefan