[PATCH] Add cl-map-into

[PATCH] Add cl-map-into

[akater]

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

Absense of Common Lisp's map-into in cl-lib is an unfortunate omission.
The proposed patch adds it.

There are several issues with existing multi-sequence cl- functions in
cl-lib.  Hopefully, our approach could be used to improve the situation.
See comment in the patch for details.

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Add cl-map-into --]
[-- Type: text/x-diff, Size: 11233 bytes --]

From c01eb04cb031f38fe3270de5a75a3809b1034750 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Wed, 15 Sep 2021 19:42:47 +0000
Subject: [PATCH] Add cl-map-into

map-into is a standard Common Lisp function that acts as cl-map, only
values are recorded into a preallocated sequence.

* lisp/emacs-lisp/cl-extra.el
(cl-map-into): New primary function
(cl--map-into-basic-call-arguments-limit,
cl--map-into-max-small-signature): New auxillary constant
(cl--map-into-mappers-array, cl--map-into-mappers-alist): New variable
(cl--compute-map-into-signature, cl--make-map-into-mapper): New auxillary function
(cl--do-seq-type-signature): New auxillary macro
---
 lisp/emacs-lisp/cl-extra.el | 228 ++++++++++++++++++++++++++++++++++++
 1 file changed, 228 insertions(+)

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 3840d13ecf..84ce153758 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -88,6 +88,234 @@ defun cl-equalp (x y)
 	(t (equal x y))))
 
 
+;;; map-into
+
+;; We implement a simple dispatcher for sequence types.
+;;
+;; cl-extra has cl--mapcar-many for similar purpose.
+;; The core issue with it, it goes through args pre-emptively
+;; to compute min length when there are more than 2 arguments
+;; which makes it and its reverse dependencies fail on circular lists
+;; unless there are <3 args.
+;; Other issues are
+;; - it performs type checks for sequences of known types at runtime
+;; - it may cons whole arglist thrice per invocation
+;; - looks like it's hard to extend.
+
+;; Our approach doesn't have these issues.
+
+(defconst cl--map-into-basic-call-arguments-limit 7
+  "Maximal reasonably expected number of arguments to `cl-map-into'.
+
+`cl-map-into' caches its code corresponding to various signature
+types of arglists supplied to `cl-map-into'.  Arglists may vary
+in length.
+
+Code corresponding to arglists of length less than
+`cl--map-into-basic-call-arguments-limit' is accessed via array.
+
+Code corresponding to arglists of length greater than or equal to
+`cl--map-into-basic-call-arguments-limit' is accessed via alist.
+")
+
+(defconst cl--map-into-max-small-signature
+  (expt 2 cl--map-into-basic-call-arguments-limit)
+  "Length of array to allocate for caching `cl-map-into' mappers
+corresponding to small arglists.
+
+Such mappers are accessed by their position in an array; position
+equals the signature.
+
+Consider `cl-map-into' arglist
+
+(target f seq-1 seq-2)
+
+call-arguments-limit corresponding to arglists of this length or
+shorter, is 4 (as there are 4 arguments).  This leaves at most 3
+sequences to contribute to type signature.
+
+Hovewer, we have to store one additional bit for fixnum-based
+encoding to be unambiguous and simple.  So overall array length
+ends up being exactly (expt 2 call-arguments-limit).")
+
+(defvar cl--map-into-mappers-array
+  (make-vector cl--map-into-max-small-signature nil)
+  "Array holding mappers corresponding to small arglists of `cl-map-into'.
+
+Element type is (or function null).")
+
+(defvar cl--map-into-mappers-alist nil
+  "Alist holding mappers corresponding to large arglists of `cl-map-into'.")
+
+(defun cl--compute-map-into-signature (&rest all-sequences)
+  "Compute lookup key for `cl-map-into''s almost-arglist ALL-SEQUENCES.
+
+Namely: ALL-SEQUENCES would be (TARGET   &rest SEQUENCES)
+               for (cl-map-into TARGET f &rest SEQUENCES)
+
+As a side effect, it checks that ALL-SEQUENCES are of sequence
+types.
+
+Example:
+ELISP> (mapcar (lambda (arglist)
+                 (apply #'cl--compute-map-into-signature arglist))
+               '(( () () () )                ; signature #b1000
+                 ( () () [] )                ; signature #b1001
+                 ( () [] () )                ; signature #b1010
+                 ( () [] [] )                ; signature #b1011
+                 ( [] () () )                ; signature #b1100
+                 ))
+(8 9 10 11 12)"
+  ;; This is not `cl-map-into'-specific and could be used for other caches
+  ;; which is why we don't specify arglist as (target &rest sequences).
+  ;; For the time being (while this dispatch is not used widely),
+  ;; neither docstring nor name reflect this.
+  (let ((signature 1))
+    (dolist (s all-sequences signature)
+      (setq signature (ash signature 1))
+      (cl-etypecase s
+        (list)
+        (vector (cl-incf signature))))))
+
+;; ;; todo: move to tests
+
+;; (cl-map-into (list 0 0 0) #'+ [41 40 39] '(1 2 3))
+;; (cl-map-into (list 0 0 0) #'+ '(1 2 3) [41 40 39])
+
+;; (let ((s (list 0 0 0)))
+;;   (cl-map-into s #'+ '(1 2 3) [41 40 39])
+;;   s)
+;; (let ((s (cl-coerce '(18 19 20) 'vector)))
+;;   (cl-map-into s #'+ s '(6 4 2 1 not-even-a-number) s)
+;;   s)
+
+(cl-defmacro cl--do-seq-type-signature ((type-var signature &optional result)
+                                        &body body)
+  "With TYPE-VAR bound to sequence type, evaluate BODY forms.  Return RESULT.
+
+TYPE-VAR goes across sequence types in an arglist corresponding
+to SIGNATURE that encodes sequence types in that arglist.
+
+Iteration goes from arglist's end to arglist's start.
+
+If :first is present at toplevel in BODY, all forms following
+it (and those forms only) are evaluated in order when TYPE-VAR is
+bound to the first sequence type in the arglist --- which would
+be the last sequence type derived from SIGNATURE: see the
+previous paragraph.  At other iteration steps, only forms
+preceding the first :first are evaluated.
+
+Subsequent instances of toplevel :first in BODY don't affect anything."
+  (declare (indent 1))
+  (let* ((main (cl-copy-list body))
+         (first (if (eq :first (car main)) (progn (setf main nil)
+                                                  (cdr main))
+                  (cl-loop with sublist = main
+                           while sublist do
+                           (when (eq :first (cadr sublist))
+                             (setf first (cddr sublist) (cdr sublist) nil)
+                             (cl-return first))
+                           (pop sublist)))))
+    (let ((sig (gensym "sig-")))
+      `(let ((,sig ,signature) ,type-var)
+         ;; (declare (type (integer (1)) ,sig)
+         ;;          ;; Let's keep nil for now.
+         ;;          (type (member nil list vector) ,type-var))
+         (cl-check-type ,sig (integer (1)))
+         (cl-loop (cond
+                   ((or (when (= 2 ,sig) (setq ,type-var 'list))
+                        (when (= 3 ,sig) (setq ,type-var 'vector)))
+                    ;; TODO: This duplicates main code sometimes,
+                    ;; think of elegant enough way to eliminate duplication.
+                    ,@(or first main) (cl-return ,result))
+                   (t (setq ,type-var (if (zerop (mod ,sig 2))
+                                          'list
+                                        'vector))
+                      ,@main))
+                  (setf ,sig (floor ,sig 2)))))))
+
+(defun cl--make-map-into-mapper (signature &optional do-not-compile)
+  "Return mapper for `cl-map-into' specialized on arglists of type encoded by SIGNATURE.
+
+If DO-NOT-COMPILE is nil (default), return byte-compiled function.
+Otherwise, return lambda form.
+
+Example:
+ELISP> (cl--make-map-into-mapper #b1011 t)
+(lambda (f target-list vector-2 vector-1)
+  (cl-symbol-macrolet ((place (car target-cons)))
+    (cl-loop for target-cons on target-list
+             for elt-2 across vector-2
+             for elt-1 across vector-1
+             do (setf place (funcall f elt-2 elt-1))
+             finally return target-list)))"
+  (let ((gensym-counter 1) f xs ss loop
+        target-type target-index target-place target-var)
+    (cl-macrolet ((nconcf (var &rest seqs) `(setf ,var (nconc ,@seqs ,var))))
+      ;; The only good thing about this name is, it's short and ends with f
+      (cl--do-seq-type-signature (type signature)
+        (nconcf loop (list 'for (let ((it (gensym "elt-")))
+                                  (push it xs)
+                                  (cl-decf gensym-counter)
+                                  it)
+                           (cl-case type
+                             (list 'in)
+                             (vector 'across))
+                           (let ((it (gensym (concat (symbol-name type) "-"))))
+                             (push it ss)
+                             it)))
+        :first (setq target-type type
+                     target-var (make-symbol
+                                 (concat "target-" (symbol-name target-type))))
+        (nconcf loop (list 'for)
+                (cl-case type
+                  (list (list (setq target-index (make-symbol "target-cons"))
+                              'on target-var))
+                  (vector (list (setq target-index (gensym "target-i"))
+                                'to `(1- (length ,target-var))))))))
+    (funcall
+     (if do-not-compile #'identity #'byte-compile)
+     `(lambda ,(cons (setq f (make-symbol "f")) (cons target-var ss))
+        (cl-symbol-macrolet ((,(setq target-place (make-symbol "place"))
+                              ,(cl-case target-type
+                                 (list `(car ,target-index))
+                                 (vector `(aref ,target-var ,target-index)))))
+          (cl-loop ,@(nconc loop `(do (setf ,target-place (funcall ,f ,@xs))
+                                      ;; Bytecode looks better
+                                      ;; with finally return ..
+                                      ;; than with finally (cl-return ..).
+                                      finally return ,target-var))))))))
+
+(defun cl-map-into (target function &rest sequences)
+  "Common Lisp's map-into.
+
+Destructively modify TARGET to contain the results of applying
+FUNCTION to each element in the argument SEQUENCES in turn.
+
+TARGET and each element of SEQUENCES can each be either a list
+or a vector.  If TARGET and each element of SEQUENCES are not
+all the same length, the iteration terminates when the shortest sequence
+(of any of the SEQUENCES or the TARGET) is exhausted.  If TARGET
+is longer than the shortest element of SEQUENCES, extra elements
+at the end of TARGET are left unchanged."
+  (cl-check-type function function)
+  (apply
+   (let* ((sig (apply #'cl--compute-map-into-signature target sequences))
+          (small (< sig cl--map-into-max-small-signature)))
+     (cl-symbol-macrolet ((basic-cache (aref cl--map-into-mappers-array sig))
+                          (general-cache
+                           ;; TODO: Order alist entries for faster lookup
+                           ;; (note that we'll have to abandon alist-get then).
+                           (alist-get sig cl--map-into-mappers-alist
+                                      nil nil #'=)))
+       (or (and small basic-cache)
+           (and (not small) general-cache)
+           (let ((mapper (cl--make-map-into-mapper sig)))
+             (if small (setf basic-cache mapper)
+               (setf general-cache mapper))))))
+   function target sequences))
+
+
 ;;; Control structures.
 
 ;;;###autoload
-- 
2.32.0

Re: [PATCH] Add cl-map-into

[Stefan Monnier]

> Absense of Common Lisp's map-into in cl-lib is an unfortunate omission.

[ As someone who likes to avoid side-effects, I have a slightly different
  opinion ;-) ]

> The proposed patch adds it.

Looks pretty good.  I have a code suggestion below, but my main
comments would be:

- Could you provide some corresponding tests for test/emacs-lisp/cl-tests.el?
- Since we're (weakly) promoting seq.el over cl-lib.el, I wonder if you
  think it would be worthwhile to try and do something similar in seq.el?

> +       (or (and small basic-cache)
> +           (and (not small) general-cache)
> +           (let ((mapper (cl--make-map-into-mapper sig)))
> +             (if small (setf basic-cache mapper)
> +               (setf general-cache mapper))))))

This can turn into

          (or (if small basic-cache general-cache)
              (let ((mapper (cl--make-map-into-mapper sig)))
                (setf (if small basic-cache general-cache)
                      mapper)))

AKA

          (or (if small basic-cache general-cache)
              (setf (if small basic-cache general-cache)
                    (cl--make-map-into-mapper sig)))

which thus looks very much like what I used in
`cl--generic-with-memoization`, so you could replace the symbol-macrolet
with something like:

    (cl--generic-with-memoization
        (if small
            (aref cl--map-into-mappers-array sig)
          ;; TODO: Order alist entries for faster lookup
          ;; (note that we'll have to abandon alist-get then).
          (alist-get sig cl--map-into-mappers-alist nil nil #'=))
      (cl--make-map-into-mapper sig))


-- Stefan

Re: [PATCH] Add cl-map-into

[akater]

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

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

> - Could you provide some corresponding tests for test/emacs-lisp/cl-tests.el?

There are some tests in comments; I'll make them into proper tests and
add some more.

>     (cl--generic-with-memoization
>         (if small
>             (aref cl--map-into-mappers-array sig)
>           ;; TODO: Order alist entries for faster lookup
>           ;; (note that we'll have to abandon alist-get then).
>           (alist-get sig cl--map-into-mappers-alist nil nil #'=))
>       (cl--make-map-into-mapper sig))

I didn't now there was (setf if).  Good, I'll use it.  Only it would be
confusing to make cl-extra dependent on cl-generic.  with-memoization
better be in cl-lib proper which is also suggested in my cl-flet patch
(the big one).  I was unable to move it out of cl-generic into cl-macs
--- Emacs failed to build when I moved it and made an alias in
cl-generic.  Do you agree it should be moved, at least for the sake of
cl-map-into?  Actually, I think it could be “public” rather than --'ed.
Just make it with-memoization in subr-x or some other file that is
commonly required at build time, why not?

> - Since we're (weakly) promoting seq.el over cl-lib.el, I wonder if you
>   think it would be worthwhile to try and do something similar in seq.el?

None of seq- functions accepts arbitrary number of arguments so I don't
see how this particular dispatcher would be useful for seq.el.

However, this is an interesting topic.

seq.el was recently rewritten in terms of cl-generic which in my view
was wasteful and overall unfortunate.  I recently came to conclusion
that CLOS should only be used when method combination is used
significantly.  This conclusion is not shared by Common Lisp veterans in
#commonlisp at libera.chat which is the first time I disagree with
Common Lisp veterans on CL.  But still, it is not very surprising; looks
like method combination has been underappreciated since its inception.

seq- does not define a single class and I don't see how any of the
methods it defines could be conceivably combined with any other methods
imaginable.  That means, all the intricate dispatching powers of CLOS
are just wasted on seq.el.  Not only that; using CLOS introduces (for no
reason since inheritance ends up unused, with no prospective use cases
in sight) limitations on what seq's dispatchers could possibly do.
CLOS' dispatch is tailored for combining code by means of inheritance.
That means, types that can't be classes (i.e. types that are
incompatible with “most-specific” / “least-specific” ordering) are out
of service.  If one needs an interesting method for a type that can't be
a class (true for numeric ranges, for most of what modern compilers do,
you name it), one simply can't have it.

To conclude, I think seq would benefit from a different dispatch
mechanism that is not shoehorned into it.

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

Re: [PATCH] Add cl-map-into

[Stefan Monnier]

> cl-map-into?  Actually, I think it could be “public” rather than --'ed.
> Just make it with-memoization in subr-x or some other file that is
> commonly required at build time, why not?

`subr-x` sounds like a good place for it, yes (assuming we can get
bootstrap to work, that is ;-).


        Stefan

Re: [PATCH] Add cl-map-into

[Bozhidar Batsov]

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

Great idea! I think having `with-memoization`/`memoize` would be pretty useful in general. E.g. in Clojure that's a built-in https://clojuredocs.org/clojure.core/memoize

On Wed, Sep 29, 2021, at 11:26 PM, Stefan Monnier wrote:
> > cl-map-into?  Actually, I think it could be “public” rather than --'ed.
> > Just make it with-memoization in subr-x or some other file that is
> > commonly required at build time, why not?
> 
> `subr-x` sounds like a good place for it, yes (assuming we can get
> bootstrap to work, that is ;-).
> 
> 
>         Stefan
> 
> 
> 

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

Re: [PATCH] Add cl-map-into

[Adam Porter]

"Bozhidar Batsov" <bozhidar@batsov.dev> writes:

> Great idea! I think having `with-memoization`/`memoize` would be
> pretty useful in general. E.g. in Clojure that's a built-in
> https://clojuredocs.org/clojure.core/memoize

Note that there exists an Elisp memoize library, Skeeto's:

https://github.com/skeeto/emacs-memoize

But there are some performance issues in general, e.g. Chris explains
some here:

https://github.com/skeeto/emacs-memoize/issues/11

Re: [PATCH] Add cl-map-into

[Bozhidar Batsov]

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

Yeah, I'm aware of this, but I think it won't hurt to have such an useful utility in Emacs itself.

On Thu, Sep 30, 2021, at 4:03 PM, Adam Porter wrote:
> "Bozhidar Batsov" <bozhidar@batsov.dev> writes:
> 
> > Great idea! I think having `with-memoization`/`memoize` would be
> > pretty useful in general. E.g. in Clojure that's a built-in
> > https://clojuredocs.org/clojure.core/memoize
> 
> Note that there exists an Elisp memoize library, Skeeto's:
> 
> https://github.com/skeeto/emacs-memoize
> 
> But there are some performance issues in general, e.g. Chris explains
> some here:
> 
> https://github.com/skeeto/emacs-memoize/issues/11
> 
> 
> 

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

Re: [PATCH] Add cl-map-into

[Adam Porter]

"Bozhidar Batsov" <bozhidar@batsov.dev> writes:

> Yeah, I'm aware of this, but I think it won't hurt to have such an
> useful utility in Emacs itself.

Agreed, but what about issues of cache expiration, memory usage, etc?
Those seem important for general use, and memoize.el handles them.

Re: [PATCH] Add cl-map-into

[akater]

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


> Agreed, but what about issues of cache expiration, memory usage, etc?
> Those seem important for general use, and memoize.el handles them.

I agree, memoization is complicated.  I think it would be reasonable to
name this one “with-simple-memoization”.

Stefan, when the macro becomes available in subr-x or in another “low
level package/feature”, I'll update both this patch and the cl-flet one.

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

Re: [PATCH] Add cl-map-into

[Stefan Monnier]

> Great idea! I think having `with-memoization`/`memoize` would be pretty
> useful in general. E.g. in Clojure that's a built-in
> https://clojuredocs.org/clojure.core/memoize

I'm glad you're enthusiastic about it.
`with-memoization` is now in `subr-x.el`.

But note that it's just a very simple macro, it's a far cry from an
actual memoization system.


        Stefan

Re: [PATCH] Add cl-map-into

[Eli Zaretskii]

> From: Stefan Monnier <monnier@iro.umontreal.ca>
> Cc: "Emacs Devel" <emacs-devel@gnu.org>
> Date: Fri, 01 Oct 2021 14:40:46 -0400
> 
> `with-memoization` is now in `subr-x.el`.

Is that the reason for the below?

  In end of data:
  emacs-lisp/ert.el:66:1: Warning: the function `with-memoization' might not be
      defined at runtime.

  In end of data:
  erc/erc.el:67:1: Warning: the function `with-memoization' might not be defined
      at runtime.

  In end of data:
  gnus/gnus-icalendar.el:39:1: Warning: the function `with-memoization' might
      not be defined at runtime.

  In end of data:
  progmodes/erts-mode.el:27:1: Warning: the function `with-memoization' might
      not be defined at runtime.

  In end of data:
  progmodes/etags.el:37:1: Warning: the function `with-memoization' is not known
      to be defined.

  In end of data:
  progmodes/xref.el:75:1: Warning: the function `with-memoization' is not known
      to be defined.

Re: [PATCH] Add cl-map-into

[Tassilo Horn]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Stefan Monnier <monnier@iro.umontreal.ca>
>> Cc: "Emacs Devel" <emacs-devel@gnu.org>
>> Date: Fri, 01 Oct 2021 14:40:46 -0400
>> 
>> `with-memoization` is now in `subr-x.el`.
>
> Is that the reason for the below?
>
>   In end of data:
>   emacs-lisp/ert.el:66:1: Warning: the function `with-memoization' might not be
>       defined at runtime.
>
> [...]

If it were just that!  I get tons of "Invalid function:
with-memoization" errors everywhere including in "make bootstrap" when
compiling json.el.

I think I've fixed the problem in e165bf3d49 but, Stefan, please check
if that's the right fix.  (And the "If" in the commit message ought to
be a "Fix", sorry.)

Bye,
Tassilo

Re: [PATCH] Add cl-map-into

[Stefan Monnier]

> If it were just that!  I get tons of "Invalid function:
> with-memoization" errors everywhere including in "make bootstrap" when
> compiling json.el.
>
> I think I've fixed the problem in e165bf3d49 but, Stefan, please check
> if that's the right fix.  (And the "If" in the commit message ought to
> be a "Fix", sorry.)

Ah, I pushed "the same fix" written differently :-(


        Stefan

Re: [PATCH] Add cl-map-into

[Glenn Morris]

Stefan Monnier wrote:

> Ah, I pushed "the same fix" written differently :-(

loadhist-tests-file-requires fails since 2fcd34f.

Re: [PATCH] Add cl-map-into

[Stefan Monnier]

Glenn Morris [2021-10-01 18:08:58] wrote:
> Stefan Monnier wrote:
>> Ah, I pushed "the same fix" written differently :-(
> loadhist-tests-file-requires fails since 2fcd34f.

Should be fixed now,


        Stefan

Re: [PATCH] Add cl-map-into, revision 2

[akater]

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


New version of the patch.  Changes:

- Use with-memoization
- Add tests
- Trim docstrings

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Add cl-map-into --]
[-- Type: text/x-diff, Size: 12748 bytes --]

From acf93e8ae4371dde0b56aea6d0ab58516c97e36a Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Wed, 15 Sep 2021 19:42:47 +0000
Subject: [PATCH] Add cl-map-into

map-into is a standard Common Lisp function that acts as cl-map, only
values are recorded into a preallocated sequence.

* lisp/emacs-lisp/cl-extra.el
(cl-map-into): New primary function
(cl--map-into-basic-call-arguments-limit,
cl--map-into-max-small-signature): New auxiliary constant
(cl--map-into-mappers-array, cl--map-into-mappers-alist): New variable
(cl--compute-map-into-signature, cl--make-map-into-mapper): New auxiliary function
(cl--do-seq-type-signature): New auxiliary macro
---
 lisp/emacs-lisp/cl-extra.el            | 212 +++++++++++++++++++++++++
 test/lisp/emacs-lisp/cl-extra-tests.el |  40 +++++
 2 files changed, 252 insertions(+)

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 499d26b737..12a11df62c 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -88,6 +88,218 @@ defun cl-equalp (x y)
 	(t (equal x y))))
 
 
+;;; map-into
+
+;; We implement a simple dispatcher for sequence types.
+;;
+;; cl-extra has cl--mapcar-many for similar purpose.
+;; The core issue with it, it goes through args pre-emptively
+;; to compute min length when there are more than 2 arguments
+;; which makes it and its reverse dependencies fail on circular lists
+;; unless there are <3 args.
+;; Other issues are
+;; - it performs type checks for sequences of known types at runtime
+;; - it may cons whole arglist thrice per invocation
+;; - looks like it's hard to extend.
+
+;; Our approach doesn't have these issues.
+
+(defconst cl--map-into-basic-call-arguments-limit 7
+  "Maximal reasonably expected number of arguments to `cl-map-into'.
+
+`cl-map-into' caches its code corresponding to various signature
+types of arglists supplied to `cl-map-into'.  Arglists may vary
+in length.
+
+Code corresponding to arglists of length less than
+`cl--map-into-basic-call-arguments-limit' is accessed via array.
+
+Code corresponding to arglists of length greater than or equal to
+`cl--map-into-basic-call-arguments-limit' is accessed via alist.
+")
+
+(defconst cl--map-into-max-small-signature
+  (expt 2 cl--map-into-basic-call-arguments-limit)
+  "Length of array to allocate for caching `cl-map-into' mappers
+corresponding to small arglists.
+
+Such mappers are accessed by their position in an array; position
+equals the signature.
+
+Consider `cl-map-into' arglist
+
+(target f seq-1 seq-2)
+
+call-arguments-limit corresponding to arglists of this length or
+shorter, is 4 (as there are 4 arguments).  This leaves at most 3
+sequences to contribute to type signature.
+
+Hovewer, we have to store one additional bit for fixnum-based
+encoding to be unambiguous and simple.  So overall array length
+ends up being exactly (expt 2 call-arguments-limit).")
+
+(defvar cl--map-into-mappers-array
+  (make-vector cl--map-into-max-small-signature nil)
+  "Array holding mappers corresponding to small arglists of `cl-map-into'.
+
+Element type is (or function null).")
+
+(defvar cl--map-into-mappers-alist nil
+  "Alist holding mappers corresponding to large arglists of `cl-map-into'.")
+
+(defun cl--compute-map-into-signature (&rest all-sequences)
+  "Compute lookup key for `cl-map-into''s almost-arglist ALL-SEQUENCES.
+
+Namely: ALL-SEQUENCES would be (TARGET   &rest SEQUENCES)
+               for (cl-map-into TARGET f &rest SEQUENCES)
+
+As a side effect, it checks that ALL-SEQUENCES are of sequence
+types.
+
+Example:
+ELISP> (mapcar (lambda (arglist)
+                 (apply #'cl--compute-map-into-signature arglist))
+               '(( () () () )                ; signature #b1000
+                 ( () () [] )                ; signature #b1001
+                 ( () [] () )                ; signature #b1010
+                 ( () [] [] )                ; signature #b1011
+                 ( [] () () )                ; signature #b1100
+                 ))
+(8 9 10 11 12)"
+  ;; This is not `cl-map-into'-specific and could be used for other caches
+  ;; which is why we don't specify arglist as (target &rest sequences).
+  ;; For the time being (while this dispatch is not used widely),
+  ;; neither docstring nor name reflect this.
+  (let ((signature 1))
+    (dolist (s all-sequences signature)
+      (setq signature (ash signature 1))
+      (cl-etypecase s
+        (list)
+        (vector (cl-incf signature))))))
+
+(cl-defmacro cl--do-seq-type-signature ((type-var signature &optional result)
+                                        &body body)
+  "With TYPE-VAR bound to sequence type, evaluate BODY forms.  Return RESULT.
+
+TYPE-VAR goes across sequence types in an arglist corresponding
+to SIGNATURE that encodes sequence types in that arglist.
+
+Iteration goes from arglist's end to arglist's start.
+
+If :first is present at toplevel in BODY, all forms following
+it (and those forms only) are evaluated in order when TYPE-VAR is
+bound to the first sequence type in the arglist --- which would
+be the last sequence type derived from SIGNATURE: see the
+previous paragraph.  At other iteration steps, only forms
+preceding the first :first are evaluated.
+
+Subsequent instances of toplevel :first in BODY don't affect anything."
+  (declare (indent 1))
+  (let* ((main (cl-copy-list body))
+         (first (if (eq :first (car main)) (progn (setf main nil)
+                                                  (cdr main))
+                  (cl-loop with sublist = main
+                           while sublist do
+                           (when (eq :first (cadr sublist))
+                             (setf first (cddr sublist) (cdr sublist) nil)
+                             (cl-return first))
+                           (pop sublist)))))
+    (let ((sig (gensym "sig-")))
+      `(let ((,sig ,signature) ,type-var)
+         ;; (declare (type (integer (1)) ,sig)
+         ;;          ;; Let's keep nil for now.
+         ;;          (type (member nil list vector) ,type-var))
+         (cl-check-type ,sig (integer (1)))
+         (cl-loop (cond
+                   ((or (when (= 2 ,sig) (setq ,type-var 'list))
+                        (when (= 3 ,sig) (setq ,type-var 'vector)))
+                    ;; TODO: This duplicates main code sometimes,
+                    ;; think of elegant enough way to eliminate duplication.
+                    ,@(or first main) (cl-return ,result))
+                   (t (setq ,type-var (if (zerop (mod ,sig 2))
+                                          'list
+                                        'vector))
+                      ,@main))
+                  (setf ,sig (floor ,sig 2)))))))
+
+(defun cl--make-map-into-mapper (signature &optional do-not-compile)
+  "Return mapper for `cl-map-into' specialized on arglists of type
+encoded by SIGNATURE.
+
+If DO-NOT-COMPILE is nil (default), return byte-compiled function.
+Otherwise, return lambda form.
+
+Example:
+ELISP> (cl--make-map-into-mapper #b1011 t)
+(lambda (f target-list vector-2 vector-1)
+  (cl-symbol-macrolet ((place (car target-cons)))
+    (cl-loop for target-cons on target-list
+             for elt-2 across vector-2
+             for elt-1 across vector-1
+             do (setf place (funcall f elt-2 elt-1))
+             finally return target-list)))"
+  (let ((gensym-counter 1) f xs ss loop
+        target-type target-index target-place target-var)
+    (cl-macrolet ((nconcf (var &rest seqs) `(setf ,var (nconc ,@seqs ,var))))
+      ;; The only good thing about this name is, it's short and ends with f
+      (cl--do-seq-type-signature (type signature)
+        (nconcf loop (list 'for (let ((it (gensym "elt-")))
+                                  (push it xs)
+                                  (cl-decf gensym-counter)
+                                  it)
+                           (cl-case type
+                             (list 'in)
+                             (vector 'across))
+                           (let ((it (gensym (concat (symbol-name type) "-"))))
+                             (push it ss)
+                             it)))
+        :first (setq target-type type
+                     target-var (make-symbol
+                                 (concat "target-" (symbol-name target-type))))
+        (nconcf loop (list 'for)
+                (cl-case type
+                  (list (list (setq target-index (make-symbol "target-cons"))
+                              'on target-var))
+                  (vector (list (setq target-index (gensym "target-i"))
+                                'to `(1- (length ,target-var))))))))
+    (funcall
+     (if do-not-compile #'identity #'byte-compile)
+     `(lambda ,(cons (setq f (make-symbol "f")) (cons target-var ss))
+        (cl-symbol-macrolet ((,(setq target-place (make-symbol "place"))
+                              ,(cl-case target-type
+                                 (list `(car ,target-index))
+                                 (vector `(aref ,target-var ,target-index)))))
+          (cl-loop ,@(nconc loop `(do (setf ,target-place (funcall ,f ,@xs))
+                                      ;; Bytecode looks better
+                                      ;; with finally return ..
+                                      ;; than with finally (cl-return ..).
+                                      finally return ,target-var))))))))
+
+(defun cl-map-into (target function &rest sequences)
+  "Common Lisp's map-into.
+
+Destructively modify TARGET to contain the results of applying
+FUNCTION to each element in the argument SEQUENCES in turn.
+
+TARGET and each element of SEQUENCES can each be either a list
+or a vector.  If TARGET and each element of SEQUENCES are not
+all the same length, the iteration terminates when the shortest sequence
+(of any of the SEQUENCES or the TARGET) is exhausted.  If TARGET
+is longer than the shortest element of SEQUENCES, extra elements
+at the end of TARGET are left unchanged."
+  (cl-check-type function function)
+  (apply
+   (let* ((sig (apply #'cl--compute-map-into-signature target sequences))
+          (small (< sig cl--map-into-max-small-signature)))
+     (with-memoization (if small (aref cl--map-into-mappers-array sig)
+                         ;; TODO: Order alist entries for faster lookup
+                         ;; (note that we'll have to abandon alist-get then).
+                         (alist-get sig cl--map-into-mappers-alist
+                                    nil nil #'=))
+       (cl--make-map-into-mapper sig)))
+   function target sequences))
+
+
 ;;; Control structures.
 
 ;;;###autoload
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el
index 91f0a1e201..4cf5d84220 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -35,6 +35,46 @@
     (should (eq (cl-getf plist 'y :none) nil))
     (should (eq (cl-getf plist 'z :none) :none))))
 
+(ert-deftest cl-map-into ()
+  (should (equal '(42 42 42)
+                 (cl-map-into (list 0 0 0) #'+ '(1 2 3) [41 40 39])))
+  (should (equal '(42 42 42)
+                 (cl-map-into (list 0 0 0) #'+ [41 40 39] '(1 2 3))))
+  (should (equal '(42 42 42)
+                 (cl-map-into (list 0 0 0) #'* '(1 2 3) [42 21 14])))
+  (should (equal '(42 42 42)
+                 (let ((s (list 0 0 0)))
+                   (cl-map-into s #'+ '(1 2 3) [41 40 39])
+                   s)))
+  (should (equal '(42 42 42)
+                 (let ((s (list 0 0 0)))
+                   (cl-map-into s #'+ s [41 40 39] '(1 2 3))
+                   s)))
+  (should (equal '(42 42 42)
+                 (let ((s (list 0 0 0)))
+                   (cl-map-into s #'+ '(1 2 3) s [41 40 39])
+                   s)))
+  (should (equal '(42 42 42)
+                 (let ((s (list 0 0 0)))
+                   (cl-map-into s #'+ '(1 2 3) [41 40 39] s)
+                   s)))
+  (should (equal '(42 42 42)
+                 (let ((s (list 18 19 20)))
+                   (cl-map-into s #'+ s '(6 4 2 1 not-even-a-number) s)
+                   s)))
+  (should (equal [42 42 42]
+                 (let ((s (vector 0 0 0)))
+                   (cl-map-into s #'+ '(1 2 3) [41 40 39])
+                   s)))
+  (should (equal [42 42 42]
+                 (let ((s (vector 0 0 0)))
+                   (cl-map-into s #'+ [41 40 39] '(1 2 3))
+                   s)))
+  (should (equal [42 42 42]
+                 (let ((s (vector 18 19 20)))
+                   (cl-map-into s #'+ s '(6 4 2 1 not-even-a-number) s)
+                   s))))
+
 (ert-deftest cl-extra-test-mapc ()
   (let ((lst '(a b c))
         (lst2 '(d e f))
-- 
2.32.0

Re: [PATCH] Add cl-map-into, revision 2

[Eli Zaretskii]

> From: akater <nuclearspace@gmail.com>
> Date: Wed, 06 Oct 2021 23:35:59 +0000
> Cc: emacs-devel@gnu.org
> 
> map-into is a standard Common Lisp function that acts as cl-map, only
> values are recorded into a preallocated sequence.
> 
> * lisp/emacs-lisp/cl-extra.el
> (cl-map-into): New primary function
> (cl--map-into-basic-call-arguments-limit,
> cl--map-into-max-small-signature): New auxiliary constant
> (cl--map-into-mappers-array, cl--map-into-mappers-alist): New variable
> (cl--compute-map-into-signature, cl--make-map-into-mapper): New auxiliary function
> (cl--do-seq-type-signature): New auxiliary macro

Thanks.  Please always accompany changes that introduce new features
by corresponding changes to documentation.  The Common Lisp
compatibility library is documented in cl.texi, and the new macro(s)
should be called out in NEWS.

See some additional minor comments below.

> +(cl-defmacro cl--do-seq-type-signature ((type-var signature &optional result)
> +                                        &body body)
> +  "With TYPE-VAR bound to sequence type, evaluate BODY forms.  Return RESULT.

The first line of a doc string should be a single sentence, not longer
than 79 characters.

> +(defun cl--make-map-into-mapper (signature &optional do-not-compile)
> +  "Return mapper for `cl-map-into' specialized on arglists of type
> +encoded by SIGNATURE.

Same here.

> +(defun cl-map-into (target function &rest sequences)
> +  "Common Lisp's map-into.

The first line of a doc string of a public interface should describe
the arguments, at least the mandatory ones.

> +TARGET and each element of SEQUENCES can each be either a list
> +or a vector.

Is there any reasons you excluded other kinds of sequences (strings
and bool-vectors)?

> +(ert-deftest cl-map-into ()
> +  (should (equal '(42 42 42)
> +                 (cl-map-into (list 0 0 0) #'+ '(1 2 3) [41 40 39])))
> +  (should (equal '(42 42 42)
> +                 (cl-map-into (list 0 0 0) #'+ [41 40 39] '(1 2 3))))
> +  (should (equal '(42 42 42)
> +                 (cl-map-into (list 0 0 0) #'* '(1 2 3) [42 21 14])))
> +  (should (equal '(42 42 42)
> +                 (let ((s (list 0 0 0)))
> +                   (cl-map-into s #'+ '(1 2 3) [41 40 39])
> +                   s)))
> +  (should (equal '(42 42 42)
> +                 (let ((s (list 0 0 0)))
> +                   (cl-map-into s #'+ s [41 40 39] '(1 2 3))
> +                   s)))
> +  (should (equal '(42 42 42)
> +                 (let ((s (list 0 0 0)))
> +                   (cl-map-into s #'+ '(1 2 3) s [41 40 39])
> +                   s)))
> +  (should (equal '(42 42 42)
> +                 (let ((s (list 0 0 0)))
> +                   (cl-map-into s #'+ '(1 2 3) [41 40 39] s)
> +                   s)))
> +  (should (equal '(42 42 42)
> +                 (let ((s (list 18 19 20)))
> +                   (cl-map-into s #'+ s '(6 4 2 1 not-even-a-number) s)
> +                   s)))
> +  (should (equal [42 42 42]
> +                 (let ((s (vector 0 0 0)))
> +                   (cl-map-into s #'+ '(1 2 3) [41 40 39])
> +                   s)))
> +  (should (equal [42 42 42]
> +                 (let ((s (vector 0 0 0)))
> +                   (cl-map-into s #'+ [41 40 39] '(1 2 3))
> +                   s)))
> +  (should (equal [42 42 42]
> +                 (let ((s (vector 18 19 20)))
> +                   (cl-map-into s #'+ s '(6 4 2 1 not-even-a-number) s)
> +                   s))))
> +

I don't see here any tests where the lengths of the sequences are
different.  Can you add some of those?

Thanks again for working on this.

Re: [PATCH] Add cl-map-into, revision 2

[akater]

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

Eli Zaretskii <eliz@gnu.org> writes:

> Is there any reasons you excluded other kinds of sequences (strings
> and bool-vectors)?

I forgot strings aren't vectors in Elisp (I rarely deal with vectors).

Both strings and bool-vectors are arrays so I could simply replace
vector with array wherever it matters.  This would include char-tables
too; I don't have experience with those.

But it is conceivale that Elisp might get arrays that are not sequences
in the future.  E.g. CL has multidimensional arrays.  Elisp manual
mentions “all [currently defind types of array are] one-dimensional” so
the notion of multidimensional array is recognised already.

It thus would be nice to have a special type for one-dimensional array.
In CL, it's precisely “vector”.

Anyway, I don't hope this type will appear soon so for the time being
I'll just replace “vector” with “array”.

>> +  (should (equal [42 42 42]
>> +                 (let ((s (vector 18 19 20)))
>> +                   (cl-map-into s #'+ s '(6 4 2 1 not-even-a-number) s)
>> +                   s))))
>> +
>
> I don't see here any tests where the lengths of the sequences are
> different.  Can you add some of those?

Lengths are different in the last test.

But it reminded me that I should add an example with a circular list.
After all, this is the case where current implementations of cl-
mappers break (for 3 arguments and beyond).

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

Re: [PATCH] Add cl-map-into, revision 2

[Eli Zaretskii]

> From: akater <nuclearspace@gmail.com>
> Cc: monnier@iro.umontreal.ca, emacs-devel@gnu.org
> Date: Thu, 07 Oct 2021 08:24:32 +0000
> 
> > Is there any reasons you excluded other kinds of sequences (strings
> > and bool-vectors)?
> 
> I forgot strings aren't vectors in Elisp (I rarely deal with vectors).
> 
> Both strings and bool-vectors are arrays so I could simply replace
> vector with array wherever it matters.  This would include char-tables
> too; I don't have experience with those.

char-tables are not simple arrays, so including them would be not
trivial, I think.

> But it is conceivale that Elisp might get arrays that are not sequences
> in the future.  E.g. CL has multidimensional arrays.  Elisp manual
> mentions “all [currently defind types of array are] one-dimensional” so
> the notion of multidimensional array is recognised already.
> 
> It thus would be nice to have a special type for one-dimensional array.
> In CL, it's precisely “vector”.
> 
> Anyway, I don't hope this type will appear soon so for the time being
> I'll just replace “vector” with “array”.

Actually, I think "sequence" is more general than "array" in Emacs
Lisp, because arrays cannot have their length changed.

Re: [PATCH] Add cl-map-into, revision 3

[akater]

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

Eli Zaretskii <eliz@gnu.org> writes:

>> +(cl-defmacro cl--do-seq-type-signature ((type-var signature &optional result)
>> +                                        &body body)
>> +  "With TYPE-VAR bound to sequence type, evaluate BODY forms.  Return RESULT.
>
> The first line of a doc string should be a single sentence, not longer
> than 79 characters.
>
>> +(defun cl--make-map-into-mapper (signature &optional do-not-compile)
>> +  "Return mapper for `cl-map-into' specialized on arglists of type
>> +encoded by SIGNATURE.
>
> Same here.

This one is not public interface though.  But I fixed this one
nevertheless.

>> +(defun cl-map-into (target function &rest sequences)
>> +  "Common Lisp's map-into.
>
> The first line of a doc string of a public interface should describe
> the arguments, at least the mandatory ones.

Done.

Changes:
- NEWS (29) entry
- entry in cl.texi
- supported are list, vector, bool-vector, string
- some more tests
- make-mapper code is simplified
- “target” renamed to “result-sequence” because that's the way it is in
  cl spec
- clean docstrings

Three points remain.

- Regarding “do-not-compile” argument in make-mapper.  It would be
  better to have “compile” argument instead, with 3 possible values:
  nil, byte-compile, native-compile.  Native-compile seems to work right
  now but I'm just getting acquainted with the feature, it's not going
  smooth, and I'm not sure whether native-compile can be used by default
  in cl-map-into.  If cl-map-into won't make it into Emacs 28, I suggest
  using native-compile right away, for ease of experimentation since
  nothing depends on cl-map-into right now.

- I prefer providing examples for functions, including “internal” ones;
  most of the time examples come naturally during development so it's
  better to use them than to let them go to waste.  Usually examples are
  nowhere to submit; I thus often leave them in docstrings, especially
  when it comes to “internal” functions.  This is the case with this
  patch.  While people do this sometimes, and there's even a Common Lisp
  library that addresses this technique in some way, I'm not sure if
  this is appropriate style.

- I left a comment block in the beginning.  Since the existing mapper in
  cl-extra is buggy, I'd rather have at least some of the comments
  remain.  It will get into sight of more people this way than a mere
  bug in the tracker, and implmenting new similar dispatchers seems
  straightforward.  I'll report the bug in coming days unless the bug is
  already there.  Also commented are (possible) type declarations.  I
  think they convey something useful as well.


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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Add cl-map-into --]
[-- Type: text/x-diff, Size: 15076 bytes --]

From cebb9a88e244457428385948eaf6bac24a7e5eb1 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Wed, 15 Sep 2021 19:42:47 +0000
Subject: [PATCH] Add cl-map-into

map-into is a standard Common Lisp function that acts as cl-map, only
values are recorded into a preallocated sequence.

* lisp/emacs-lisp/cl-extra.el
(cl-map-into): New primary function
(cl--map-into-basic-call-arguments-limit,
cl--map-into-max-small-signature): New auxiliary constant
(cl--map-into-mappers-array, cl--map-into-mappers-alist): New variable
(cl--compute-map-into-signature, cl--make-map-into-mapper): New auxiliary function
(cl--do-seq-type-signature): New auxiliary macro
---
 doc/misc/cl.texi                       |   9 ++
 etc/NEWS                               |   7 +
 lisp/emacs-lisp/cl-extra.el            | 206 +++++++++++++++++++++++++
 test/lisp/emacs-lisp/cl-extra-tests.el |  61 ++++++++
 4 files changed, 283 insertions(+)

diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 04e2c71a2b..45cea26d4e 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -3301,6 +3301,15 @@ be one of the following symbols: @code{vector}, @code{string},
 thrown away and @code{cl-map} returns @code{nil}).
 @end defun
 
+@defun cl-map-into result-sequence function &rest sequences
+This function is like @code{cl-map}, except that the values returned by
+@var{function} are recorded into existing @var{result-sequence} rather
+than into a newly allocated sequence of specified type.  Note also that
+while @code{cl-map} requires the function to be mapped over to accept at
+least one argument, @code{cl-map-into} does not require that from
+@var{function}.  The return value is @var{result-sequence}.
+@end defun
+
 @defun cl-maplist function list &rest more-lists
 This function calls @var{function} on each of its argument lists,
 then on the @sc{cdr}s of those lists, and so on, until the
diff --git a/etc/NEWS b/etc/NEWS
index b91a5cbb72..131df75df4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -157,6 +157,13 @@ Using 'make-obsolete' on a theme is now supported.  This will make
 ** New function 'define-keymap'.
 This function allows defining a number of keystrokes with one form.
 
++++
+** New function 'cl-map-into'.
+A counterpart of Common Lisp's 'map-into', this function destructively
+modifies a sequence passed to it to contain the results of applying a
+function passed to it to each element in the sequences passed to it,
+in turn.
+
 +++
 ** New macro 'defvar-keymap'.
 This macro allows defining keymap variables more conveniently.
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 499d26b737..df712e3237 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -88,6 +88,212 @@ defun cl-equalp (x y)
 	(t (equal x y))))
 
 
+;;; map-into
+
+;; We implement a simple dispatcher for sequence types.
+;;
+;; cl-extra has cl--mapcar-many for similar purpose.
+;; The core issue with it, it goes through args pre-emptively
+;; to compute min length when there are more than 2 arguments
+;; which makes it and its reverse dependencies fail on circular lists
+;; unless there are <3 args.
+;; Other issues are
+;; - it performs type checks for sequences of known types at runtime
+;; - it may cons whole arglist thrice per invocation
+;; - looks like it's hard to extend.
+
+;; Our approach doesn't have these issues.
+
+(defconst cl--map-into-basic-call-arguments-limit 7
+  "Maximal reasonably expected number of arguments to `cl-map-into'.
+
+`cl-map-into' caches its code corresponding to various signature
+types of arglists supplied to `cl-map-into'.  Arglists may vary
+in length.
+
+Code corresponding to arglists of length less than
+`cl--map-into-basic-call-arguments-limit' is accessed via array.
+
+Code corresponding to arglists of length greater than or equal to
+`cl--map-into-basic-call-arguments-limit' is accessed via alist.")
+
+(defconst cl--map-into-max-small-signature
+  (expt 2 cl--map-into-basic-call-arguments-limit)
+  "Length of array to allocate for caching `cl-map-into' mappers
+corresponding to small arglists.
+
+Such mappers are accessed by their position in an array; position
+equals the signature.
+
+Consider `cl-map-into' arglist
+
+(result-seq f seq-1 seq-2)
+
+call-arguments-limit corresponding to arglists of this length or
+shorter, is 4 (as there are 4 arguments).  This leaves at most 3
+sequences to contribute to type signature.
+
+Hovewer, we have to store one additional bit for fixnum-based
+encoding to be unambiguous and simple.  So overall array length
+ends up being exactly (expt 2 call-arguments-limit).")
+
+(defvar cl--map-into-mappers-array
+  (make-vector cl--map-into-max-small-signature nil)
+  "Array holding mappers corresponding to small arglists of `cl-map-into'.
+
+Element type is (or function null).")
+
+(defvar cl--map-into-mappers-alist nil
+  "Alist holding mappers corresponding to large arglists of `cl-map-into'.")
+
+(defun cl--compute-map-into-signature (&rest all-sequences)
+  "Compute lookup key for `cl-map-into''s almost-arglist ALL-SEQUENCES.
+
+Namely: ALL-SEQUENCES would be (RESULT-SEQUENCE   . SEQUENCES)
+               for (cl-map-into RESULT-SEQUENCE f . SEQUENCES)
+
+As a side effect, it checks that ALL-SEQUENCES are of sequence
+types.
+
+Example:
+ELISP> (mapcar (lambda (arglist)
+                 (apply #'cl--compute-map-into-signature arglist))
+               '(( () () () )                ; signature #b1000
+                 ( () () [] )                ; signature #b1001
+                 ( () [] () )                ; signature #b1010
+                 ( () [] [] )                ; signature #b1011
+                 ( [] () () )                ; signature #b1100
+                 ))
+(8 9 10 11 12)"
+  ;; This is not `cl-map-into'-specific and could be used for other caches
+  ;; which is why we don't specify arglist as (result &rest sequences).
+  ;; For the time being (while this dispatch is not used widely),
+  ;; neither docstring nor name reflect this.
+  (let ((signature 1))
+    (dolist (s all-sequences signature)
+      (setq signature (ash signature 1))
+      (cl-etypecase s
+        (list)
+        ((or string vector bool-vector) (cl-incf signature))))))
+
+(cl-defmacro cl--do-seq-type-signature ((type-var signature &optional result)
+                                        &body body)
+  "With TYPE-VAR bound to a sequence type, evaluate BODY forms, return RESULT.
+
+TYPE-VAR goes across sequence types in an arglist corresponding
+to SIGNATURE that encodes sequence types in that arglist.
+
+Iteration goes from arglist's end to arglist's start.
+
+If :first is present at toplevel in BODY, all forms following
+it (and those forms only) are evaluated in order when TYPE-VAR is
+bound to the first sequence type in the arglist --- which would
+be the last sequence type derived from SIGNATURE: see the
+previous paragraph.  At other iteration steps, only forms
+preceding the first :first are evaluated.
+
+Subsequent instances of toplevel :first in BODY don't affect anything."
+  (declare (indent 1))
+  (let* ((main (cl-copy-list body))
+         (first (if (eq :first (car main)) (progn (setf main nil)
+                                                  (cdr main))
+                  (cl-loop with sublist = main
+                           while sublist do
+                           (when (eq :first (cadr sublist))
+                             (setf first (cddr sublist) (cdr sublist) nil)
+                             (cl-return first))
+                           (pop sublist)))))
+    (let ((sig (make-symbol "sig")))
+      `(let ((,sig ,signature) ,type-var)
+         ;; (declare (type (integer (1)) ,sig)
+         ;;          ;; Let's keep nil for now.
+         ;;          (type (member nil list vector) ,type-var))
+         (cl-check-type ,sig (integer (1)))
+         (cl-loop (cond
+                   ((or (when (= 2 ,sig) (setq ,type-var 'list))
+                        (when (= 3 ,sig) (setq ,type-var 'array)))
+                    ;; This duplicates main code sometimes.  Maybe,
+                    ;; there is elegant enough way to eliminate duplication.
+                    ,@(or first main) (cl-return ,result))
+                   (t (setq ,type-var (if (zerop (mod ,sig 2))
+                                          'list
+                                        'array))
+                      ,@main))
+                  (setf ,sig (floor ,sig 2)))))))
+
+(defun cl--make-map-into-mapper (signature &optional do-not-compile)
+  "Return mapper for `cl-map-into' specialized on arglists of given SIGNATURE.
+
+If DO-NOT-COMPILE is nil (default), return byte-compiled function.
+Otherwise, return lambda form.
+
+Example:
+ELISP> (cl--make-map-into-mapper #b10101 t)
+(lambda (f result-list array-3 list-2 array-1)
+  (cl-loop for elt in-ref result-list
+           for elt-3 across array-3
+           for elt-2 in list-2
+           for elt-1 across array-1
+           do (setf elt (funcall f elt-3 elt-2 elt-1))
+           finally return result-list))"
+  (let ((gensym-counter 1) f xs ss loop result-elt result-var)
+    (cl--do-seq-type-signature (type signature)
+      (setq loop (nconc (list 'for (let ((it (gensym "elt-")))
+                                     (push it xs)
+                                     (cl-decf gensym-counter)
+                                     it)
+                              (cl-case type
+                                (list 'in)
+                                (array 'across))
+                              (let ((it (gensym (format "%s-" type))))
+                                (push it ss)
+                                it))
+                        loop))
+      :first
+      (setq loop (nconc (list 'for (setq result-elt (make-symbol "elt"))
+                              (cl-case type
+                                (list 'in-ref)
+                                (array 'across-ref))
+                              (setq result-var
+                                    (make-symbol (format "result-%s" type))))
+                        loop)))
+    (funcall
+     (if do-not-compile #'identity #'byte-compile)
+     `(lambda ,(cons (setq f (make-symbol "f")) (cons result-var ss))
+        (cl-loop ,@(nconc loop `(do (setf ,result-elt (funcall ,f ,@xs))
+                                    ;; Bytecode looks better
+                                    ;; with finally return ..
+                                    ;; than with finally (cl-return ..).
+                                    finally return ,result-var)))))))
+
+(defun cl-map-into (result-sequence function &rest sequences)
+  "Map FUNCTION over SEQUENCES, recording values into RESULT-SEQUENCE.
+
+RESULT-SEQUENCE is destructively modified.
+
+RESULT-SEQUENCE and each element of SEQUENCES can each be either
+a list, a vector, a string, or a bool-vector.  If RESULT-SEQUENCE
+and each element of SEQUENCES are not all the same length, the
+iteration terminates when the shortest sequence (of any of the
+SEQUENCES or the RESULT-SEQUENCE) is exhausted.  If
+RESULT-SEQUENCE is longer than the shortest element of SEQUENCES,
+extra elements at the end of RESULT-SEQUENCE are left unchanged.
+
+Return RESULT-SEQUENCE."
+  (cl-check-type function function)
+  (apply
+   (let* ((sig (apply #'cl--compute-map-into-signature result-sequence
+                      sequences))
+          (small (< sig cl--map-into-max-small-signature)))
+     (with-memoization (if small (aref cl--map-into-mappers-array sig)
+                         ;; TODO: Order alist entries for faster lookup
+                         ;; (note that we'll have to abandon alist-get then).
+                         (alist-get sig cl--map-into-mappers-alist
+                                    nil nil #'=))
+                       (cl--make-map-into-mapper sig)))
+   function result-sequence sequences))
+
+
 ;;; Control structures.
 
 ;;;###autoload
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el
index 91f0a1e201..a4f21f2edf 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -35,6 +35,67 @@
     (should (eq (cl-getf plist 'y :none) nil))
     (should (eq (cl-getf plist 'z :none) :none))))
 
+(ert-deftest cl-map-into ()
+  (should (equal '(42 42 42)
+                 (cl-map-into (list 0 0 0) #'+ '(1 2 3) [41 40 39])))
+  (should (equal '(42 42 42)
+                 (cl-map-into (list 0 0 0) #'+ [41 40 39] '(1 2 3))))
+  (should (equal '(42 42 42)
+                 (cl-map-into (list 0 0 0) #'* '(1 2 3) [42 21 14])))
+  (should (equal '(42 42 42)
+                 (let ((s (list 0 0 0)))
+                   (cl-map-into s #'+ '(1 2 3) [41 40 39])
+                   s)))
+  (should (equal '(42 42 42)
+                 (let ((s (list 0 0 0)))
+                   (cl-map-into s #'+ s [41 40 39] '(1 2 3))
+                   s)))
+  (should (equal '(42 42 42)
+                 (let ((s (list 0 0 0)))
+                   (cl-map-into s #'+ '(1 2 3) s [41 40 39])
+                   s)))
+  (should (equal '(42 42 42)
+                 (let ((s (list 0 0 0)))
+                   (cl-map-into s #'+ '(1 2 3) [41 40 39] s)
+                   s)))
+  (should (equal '(42 42 42)
+                 (let ((s (list 18 19 20)))
+                   (cl-map-into s #'+ s '(6 4 2 1 not-even-a-number) s)
+                   s)))
+  (should (equal [42 42 42]
+                 (let ((s (vector 0 0 0)))
+                   (cl-map-into s #'+ '(1 2 3) [41 40 39])
+                   s)))
+  (should (equal [42 42 42]
+                 (let ((s (vector 0 0 0)))
+                   (cl-map-into s #'+ [41 40 39] '(1 2 3))
+                   s)))
+  (should (equal [42 42 42]
+                 (let ((s (vector 18 19 20)))
+                   (cl-map-into s #'+ s '(6 4 2 1 not-even-a-number) s)
+                   s)))
+  (should (equal "Lisp"
+                 (let ((s (copy-sequence "Loop")))
+                   (cl-map-into s (lambda (mask new old) (if mask new old))
+                                (bool-vector nil t t nil) "Disjoint" s)
+                   s)))
+  (should (equal '(1 2 3)
+                 (let ((s (list 'one 'two 'three)))
+                   (cl-map-into s (let ((n 0)) (lambda () (cl-incf n))))
+                   s)))
+  (should (equal (bool-vector t nil t nil t)
+                 (let ((s (bool-vector nil nil nil nil nil)))
+                   (cl-map-into s #'cl-evenp '#1=(0 1 . #1#))
+                   s)))
+  (should (equal "GNU GNU GNU GNU"
+                 (let ((cyclically '#1=(t nil . #1#))
+                       (glue '#1=(?G ?L ?U ?E . #1#))
+                       (ants '#1=(?A ?N ?T ?\s . #1#))
+                       (s (make-string 15 0)))
+                   (cl-map-into s (lambda (x y z) (if x y z))
+                                cyclically glue ants)
+                   s))))
+
 (ert-deftest cl-extra-test-mapc ()
   (let ((lst '(a b c))
         (lst2 '(d e f))
-- 
2.32.0

Re: [PATCH] Add cl-map-into, revision 3

[Stefan Monnier]

> +(cl-defmacro cl--do-seq-type-signature ((type-var signature &optional result)
> +                                        &body body)

I'm not fond of this internal macro used at only one place.
I'd rather we write the resulting code at its caller's location.

> +      `(let ((,sig ,signature) ,type-var)
> +         ;; (declare (type (integer (1)) ,sig)
> +         ;;          ;; Let's keep nil for now.
> +         ;;          (type (member nil list vector) ,type-var))
> +         (cl-check-type ,sig (integer (1)))
> +         (cl-loop (cond
> +                   ((or (when (= 2 ,sig) (setq ,type-var 'list))
> +                        (when (= 3 ,sig) (setq ,type-var 'array)))
> +                    ;; This duplicates main code sometimes.  Maybe,
> +                    ;; there is elegant enough way to eliminate duplication.
> +                    ,@(or first main) (cl-return ,result))
> +                   (t (setq ,type-var (if (zerop (mod ,sig 2))
> +                                          'list
> +                                        'array))
> +                      ,@main))
> +                  (setf ,sig (floor ,sig 2)))))))

    (let (,type-var)
      ...
      (setq ,type-var ...)
      ...)

generates worse code than

     ...
     (let ((,type-var ...))
       ...)

> +    (funcall
> +     (if do-not-compile #'identity #'byte-compile)
> +     `(lambda ,(cons (setq f (make-symbol "f")) (cons result-var ss))

I think you meant `#'eval` (or better: (lambda (x) (eval x t))) instead
of `#'identity`.
Also you'll want to bind `lexical-binding` around the call to `byte-compile`.

> +  (apply
> +   (let* ((sig (apply #'cl--compute-map-into-signature result-sequence
> +                      sequences))
> +          (small (< sig cl--map-into-max-small-signature)))
> +     (with-memoization (if small (aref cl--map-into-mappers-array sig)
> +                         ;; TODO: Order alist entries for faster lookup
> +                         ;; (note that we'll have to abandon alist-get then).
> +                         (alist-get sig cl--map-into-mappers-alist
> +                                    nil nil #'=))
> +                       (cl--make-map-into-mapper sig)))
> +   function result-sequence sequences))

[ Makes me wonder if we could define this as a cl-generic function, and
  use something like method combinators to generate the code on the fly.
  More specifically, if we can't with the current code, it seems like
  a fun exercise to see what it would take to make it possible.  ]


        Stefan

Re: [PATCH] Add cl-map-into, revision 3

[akater]

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

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

>> +(cl-defmacro cl--do-seq-type-signature ((type-var signature &optional result)
>> +                                        &body body)
>
> I'm not fond of this internal macro used at only one place.
> I'd rather we write the resulting code at its caller's location.>

It can be reused to reimplement other functions in cl-extra.  See the
bug report on why they probably should be reimplemented:
https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-10/msg02374.html


>> +      `(let ((,sig ,signature) ,type-var)
>> +         ;; (declare (type (integer (1)) ,sig)
>> +         ;;          ;; Let's keep nil for now.
>> +         ;;          (type (member nil list vector) ,type-var))
>> +         (cl-check-type ,sig (integer (1)))
>> +         (cl-loop (cond
>> +                   ((or (when (= 2 ,sig) (setq ,type-var 'list))
>> +                        (when (= 3 ,sig) (setq ,type-var 'array)))
>> +                    ;; This duplicates main code sometimes.  Maybe,
>> +                    ;; there is elegant enough way to eliminate duplication.
>> +                    ,@(or first main) (cl-return ,result))
>> +                   (t (setq ,type-var (if (zerop (mod ,sig 2))
>> +                                          'list
>> +                                        'array))
>> +                      ,@main))
>> +                  (setf ,sig (floor ,sig 2)))))))
>
>     (let (,type-var)
>       ...
>       (setq ,type-var ...)
>       ...)
>
> generates worse code than
>
>      ...
>      (let ((,type-var ...))
>        ...)

Rewriting it with a correct initial value would complicate the code
while we don't want this code to be particularly efficient as it only
runs once per signature.


>> +    (funcall
>> +     (if do-not-compile #'identity #'byte-compile)
>> +     `(lambda ,(cons (setq f (make-symbol "f")) (cons result-var ss))
>
> I think you meant `#'eval` (or better: (lambda (x) (eval x t))) instead
> of `#'identity`.

The purpose of do-not-compile: t is to get a human-readable expression,
e.g. for better understanding and for tests (which is why it's not
made default).  eval would produce something less straightforward.


> Also you'll want to bind `lexical-binding` around the call to `byte-compile`.

Will do.  What about native-compile?  I suggested above to use it as
default (and use COMPILE rather than DO-NOT-COMPILE argname) but I'm not
familiar with it.


>> +  (apply
>> +   (let* ((sig (apply #'cl--compute-map-into-signature result-sequence
>> +                      sequences))
>> +          (small (< sig cl--map-into-max-small-signature)))
>> +     (with-memoization (if small (aref cl--map-into-mappers-array sig)
>> +                         ;; TODO: Order alist entries for faster lookup
>> +                         ;; (note that we'll have to abandon alist-get then).
>> +                         (alist-get sig cl--map-into-mappers-alist
>> +                                    nil nil #'=))
>> +                       (cl--make-map-into-mapper sig)))
>> +   function result-sequence sequences))
>
>  Makes me wonder if we could define this as a cl-generic function

Define what exactly as cl-generic function?  make-mapper?  What would it
dispatch on?

I have to reiterate: it's almost always a mistake trying to use CLOS
when there's no class hierarchy at sight.  The mistake does not seem to
be recognised even though CL users keep writing CL libraries that try to
implement non-CLOS dispatch, for valid reasons.

CLOS dispatch is deliberately limited in what it can work with, so that
it can order methods for combining.  Often, you simply need a more
general dispatch which is incompatible with predictable ordering of
methods.  Here we dispatch on signatures which are integers.  One can't
canonically order “methods” that specialize on integer ranges, for
example.  In any case, here we'd dispatch on values which are,
similarly, too complex to order into a hierarchy.  Which makes the whole
method-combination mechanism unapplicable.

>   and use something like method combinators to generate the code on
>   the fly.  More specifically, if we can't with the current code, it
>   seems like a fun exercise to see what it would take to make it
>   possible.

It so happens that I'm currently writing another general purpose
sequence-oriented library in elisp, trying to actually use cl-generic
there fore code generation.  The topic has been intriguing me for quite
some time.  But for cl-map-into, I'm fine with what's already there.  It
works, for reasonable purposes it is as efficient as compiler will allow
it to be, and it's straightforwardly extensible to other sequence types.

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