[Emacs-diffs] master 466ee1b: An efficient built-in mapcan

[Mario Lang]

branch: master
commit 466ee1b3ea76425d201b5d59950e88251870c836
Author: Mario Lang <address@hidden>
Commit: Mario Lang <address@hidden>

    An efficient built-in mapcan
    
    A built-in version of `mapcan' avoids consing up (and GC'ing) the
    intermediate list.
    
    * src/fns.c (Fmapcan): New built-in.
    (syms_of_fns): Define.
    
    * lisp/emacs-lisp/cl.el (mapcan): Remove defalias.
    
    * lisp/emacs-lisp/cl-extra.el (cl-mapcan): Use built-in `mapcan'
    if only one sequence is provided.
    
    * lisp/progmodes/hideif.el (hif-delimit):
    * lisp/dired-aux.el (dired-do-find-regexp):
    * lisp/woman.el (woman-parse-colon-path): Use `mapcan' instead of
    `cl-mapcan'.
    
    * lisp/woman.el (eval-when-compile): Require 'cl-lib only when
    compiling.
    
    * lisp/mouse.el (mouse-buffer-menu-map):
    * lisp/net/pop3.el (pop3-uidl-dele):
    * lisp/progmodes/gud.el (gud-jdb-build-source-files-list):
    * lisp/cedet/semantic/db-find.el (semanticdb-fast-strip-find-results):
    * lisp/cedet/semantic/symref/grep.el 
(semantic-symref-derive-find-filepatterns):
    * lisp/gnus/nnmail.el (nnmail-split-it):
    * lisp/gnus/gnus-sum.el (gnus-articles-in-thread):
    * lisp/gnus/gnus-registry.el (gnus-registry-sort-addresses):
    * lisp/gnus/gnus-util.el (gnus-mapcar): Use `mapcan'.
---
 etc/NEWS                           |    3 +++
 lisp/cedet/semantic/db-find.el     |    2 +-
 lisp/cedet/semantic/symref/grep.el |    2 +-
 lisp/dired-aux.el                  |    2 +-
 lisp/emacs-lisp/cl-extra.el        |    4 +++-
 lisp/emacs-lisp/cl.el              |    1 -
 lisp/gnus/gnus-registry.el         |    3 +--
 lisp/gnus/gnus-sum.el              |    2 +-
 lisp/gnus/gnus-util.el             |    2 +-
 lisp/gnus/nnmail.el                |    2 +-
 lisp/mouse.el                      |    4 ++--
 lisp/net/pop3.el                   |    3 +--
 lisp/progmodes/gud.el              |    8 ++++----
 lisp/progmodes/hideif.el           |    4 ++--
 lisp/woman.el                      |    9 ++++-----
 src/fns.c                          |   25 +++++++++++++++++++++++++
 16 files changed, 51 insertions(+), 25 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 5472dd8..6aef73a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -557,6 +557,9 @@ ABBR is a time zone abbreviation.  The affected functions 
are
 *** New basic face 'fixed-pitch-serif', for a fixed-width font with serifs.
 The Info-quoted and tex-verbatim faces now default to inheriting from it.
 
+** New built-in function `mapcan' which avoids unnecessary consing (and garbage
+   collection).
+
 
 * Changes in Emacs 25.2 on Non-Free Operating Systems
 
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index d6635a9..cd95180 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -902,7 +902,7 @@ instead."
 This makes it appear more like the results of a `semantic-find-' call.
 This is like `semanticdb-strip-find-results', except the input list RESULTS
 will be changed."
-  (apply #'nconc (mapcar #'cdr results)))
+  (mapcan #'cdr results))
 
 (defun semanticdb-find-results-p (resultp)
   "Non-nil if RESULTP is in the form of a semanticdb search result.
diff --git a/lisp/cedet/semantic/symref/grep.el 
b/lisp/cedet/semantic/symref/grep.el
index 36e97da..b232e0f 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -81,7 +81,7 @@ Optional argument MODE specifies the `major-mode' to test."
         (if (null (cdr args))
             args
           `("(" ,@args
-            ,@(apply #'nconc (mapcar (lambda (s) `("-o" "-name" ,s)) pat))
+            ,@(mapcan (lambda (s) `("-o" "-name" ,s)) pat)
             ")"))))))
 
 (defvar grepflags)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 1a4efdf..4732d9c 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -2762,7 +2762,7 @@ REGEXP should use constructs supported by your local 
`grep' command."
                           (lambda (s) (concat s "/"))
                           grep-find-ignored-directories)
                          grep-find-ignored-files))
-         (xrefs (cl-mapcan
+         (xrefs (mapcan
                  (lambda (file)
                    (xref-collect-matches regexp "*" file
                                          (and (file-directory-p file)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 8bf0675..0033a94 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -173,7 +173,9 @@ the elements themselves.
 (defun cl-mapcan (cl-func cl-seq &rest cl-rest)
   "Like `cl-mapcar', but nconc's together the values returned by the function.
 \n(fn FUNCTION SEQUENCE...)"
-  (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest)))
+  (if cl-rest
+      (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest))
+    (mapcan cl-func cl-seq)))
 
 ;;;###autoload
 (defun cl-mapcon (cl-func cl-list &rest cl-rest)
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index e48376b..fac600e 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -154,7 +154,6 @@
                every
                some
                mapcon
-               mapcan
                mapl
                maplist
                map
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index c636c7e..37d5b5b 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -826,8 +826,7 @@ Addresses without a name will say \"noname\"."
 
 (defun gnus-registry-sort-addresses (&rest addresses)
   "Return a normalized and sorted list of ADDRESSES."
-  (sort (apply 'nconc (mapcar 'gnus-registry-extract-addresses addresses))
-        'string-lessp))
+  (sort (mapcan 'gnus-registry-extract-addresses addresses) 'string-lessp))
 
 (defun gnus-registry-simplify-subject (subject)
   (if (stringp subject)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a81a4e2..910c796 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -4749,7 +4749,7 @@ If LINE, insert the rebuilt thread starting on line LINE."
 (defun gnus-articles-in-thread (thread)
   "Return the list of articles in THREAD."
   (cons (mail-header-number (car thread))
-       (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread)))))
+       (mapcan 'gnus-articles-in-thread (cdr thread))))
 
 (defun gnus-remove-thread (id &optional dont-remove)
   "Remove the thread that has ID in it."
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 906ea60..b6ef433 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1599,7 +1599,7 @@ sequence, this is like `mapcar'.  With several, it is 
like the Common Lisp
                                                           heads))
                                        nil))
             (setq ,result-tail (cdr ,result-tail)
-                  ,@(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) 
heads))))
+                  ,@(mapcan (lambda (h) (list h (list 'cdr h))) heads)))
           (cdr ,result)))
     `(mapcar ,function ,seq1)))
 
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 65a92e9..5495510 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1372,7 +1372,7 @@ See the documentation for the variable 
`nnmail-split-fancy' for details."
 
      ;; Builtin & operation.
      ((eq (car split) '&)
-      (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
+      (mapcan 'nnmail-split-it (cdr split)))
 
      ;; Builtin | operation.
      ((eq (car split) '|)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 135e1f5..4446238 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1638,8 +1638,8 @@ and selects that window."
              (let ((others-list
                     (mouse-buffer-menu-alist
                      ;; we don't need split-by-major-mode any more,
-                     ;; so we can ditch it with nconc.
-                     (apply 'nconc (mapcar 'cddr split-by-major-mode)))))
+                     ;; so we can ditch it with nconc (mapcan).
+                     (mapcan 'cddr split-by-major-mode))))
                (and others-list
                     (setq subdivided-menus
                           (cons (cons "Others" others-list)
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index d09c1d0..3964288 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -402,8 +402,7 @@ Return non-nil if it is necessary to update the local UIDL 
file."
               (push uidl new))
             (decf i)))
          (pop3-uidl
-          (setq new (apply 'nconc (mapcar (lambda (elt) (list elt ctime))
-                                          pop3-uidl)))))
+          (setq new (mapcan (lambda (elt) (list elt ctime)) pop3-uidl))))
     (when new (setq mod t))
     ;; List expirable messages and delete them from the data to be saved.
     (setq ctime (when (numberp pop3-leave-mail-on-server)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 9bf7394..ceb57b7 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -1947,10 +1947,10 @@ the source code display in sync with the debugging 
session.")
 PATH gives the directories in which to search for files with
 extension EXTN.  Normally EXTN is given as the regular expression
  \"\\.java$\" ."
-  (apply 'nconc (mapcar (lambda (d)
-                         (when (file-directory-p d)
-                           (directory-files d t extn nil)))
-                       path)))
+  (mapcan (lambda (d)
+            (when (file-directory-p d)
+              (directory-files d t extn nil)))
+          path))
 
 ;; Move point past whitespace.
 (defun gud-jdb-skip-whitespace ()
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 6b5f51a..9fbb7d6 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -1114,8 +1114,8 @@ preprocessing token"
       result)))
 
 (defun hif-delimit (lis atom)
-  (nconc (cl-mapcan (lambda (l) (list l atom))
-                    (butlast lis))
+  (nconc (mapcan (lambda (l) (list l atom))
+                 (butlast lis))
          (last lis)))
 
 ;; Perform token replacement:
diff --git a/lisp/woman.el b/lisp/woman.el
index 8189f08..b316207 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -414,9 +414,8 @@
               (substring arg 0 (match-end 1))
             arg))))
 
-(require 'cl-lib)
-
 (eval-when-compile                     ; to avoid compiler warnings
+  (require 'cl-lib)
   (require 'dired)
   (require 'apropos))
 
@@ -434,7 +433,7 @@ As a special case, if PATHS is nil then replace it by 
calling
             (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf)))
            ((string-match-p ";" paths)
             ;; Assume DOS-style path-list...
-            (cl-mapcan                 ; splice list into list
+            (mapcan                    ; splice list into list
              (lambda (x)
                (if x
                    (list x)
@@ -445,14 +444,14 @@ As a special case, if PATHS is nil then replace it by 
calling
             (list paths))
            (t
             ;; Assume UNIX/Cygwin-style path-list...
-            (cl-mapcan                 ; splice list into list
+            (mapcan                    ; splice list into list
              (lambda (x)
                (mapcar 'woman-Cyg-to-Win
                        (if x (list x) (woman-parse-man.conf))))
              (let ((path-separator ":"))
                (parse-colon-path paths)))))
     ;; Assume host-default-style path-list...
-    (cl-mapcan                         ; splice list into list
+    (mapcan                            ; splice list into list
      (lambda (x) (if x (list x) (woman-parse-man.conf)))
      (parse-colon-path (or paths "")))))
 
diff --git a/src/fns.c b/src/fns.c
index dbee33a..270dfb4 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2654,6 +2654,30 @@ SEQUENCE may be a list, a vector, a bool-vector, or a 
string.  */)
 
   return sequence;
 }
+
+DEFUN ("mapcan", Fmapcan, Smapcan, 2, 2, 0,
+       doc: /* Apply FUNCTION to each element of SEQUENCE, and concatenate
+the results by altering them (using `nconc').
+SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
+     (Lisp_Object function, Lisp_Object sequence)
+{
+  register EMACS_INT leni;
+  register Lisp_Object *args;
+  Lisp_Object ret;
+  USE_SAFE_ALLOCA;
+
+  if (CHAR_TABLE_P (sequence))
+    wrong_type_argument (Qlistp, sequence);
+
+  leni = XFASTINT (Flength (sequence));
+  SAFE_ALLOCA_LISP (args, leni);
+  mapcar1 (leni, args, function, sequence);
+  ret = Fnconc (leni, args);
+
+  SAFE_FREE ();
+
+  return ret;
+}
 
 /* This is how C code calls `yes-or-no-p' and allows the user
    to redefine it.  */
@@ -5203,6 +5227,7 @@ this variable.  */);
   defsubr (&Snconc);
   defsubr (&Smapcar);
   defsubr (&Smapc);
+  defsubr (&Smapcan);
   defsubr (&Smapconcat);
   defsubr (&Syes_or_no_p);
   defsubr (&Sload_average);