Re: [PATCH] Some improvements for cl-flet

[Stefan Monnier <monnier@iro.umontreal.ca>]

>> 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)