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'.

16 files changed, 51 insertions, 25 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 5472dd84b7..6aef73a3c9 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 d6635a9dce..cd951804db 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 36e97da818..b232e0fb61 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 1a4efdfd9f..4732d9ce85 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 8bf0675f54..0033a94fb5 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 e48376bbab..fac600e4e1 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 c636c7eb32..37d5b5b91a 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 a81a4e24c4..910c796915 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 906ea60377..b6ef4334e7 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 65a92e904e..5495510d94 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 135e1f5d71..44462385b6 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 d09c1d00fa..3964288fd2 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 9bf739463e..ceb57b7156 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 6b5f51a3fb..9fbb7d6ad3 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 8189f08b09..b3162074c4 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 dbee33aa9f..270dfb41c1 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);