From 466ee1b3ea76425d201b5d59950e88251870c836 Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Sun, 10 Jul 2016 01:18:47 +0200 Subject: [PATCH] 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 5472dd84b77..6aef73a3c96 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 d6635a9dcef..cd951804db7 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 36e97da818d..b232e0fb619 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 1a4efdfd9fb..4732d9ce85c 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 8bf0675f54b..0033a94fb5c 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 e48376bbabd..fac600e4e13 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 c636c7eb32b..37d5b5b91ad 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 a81a4e24c41..910c796915a 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 906ea603770..b6ef4334e7e 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 65a92e904e3..5495510d94a 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 135e1f5d71f..44462385b6c 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 d09c1d00fad..3964288fd23 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 9bf739463ed..ceb57b7156d 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 6b5f51a3fbd..9fbb7d6ad32 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 8189f08b097..b3162074c4e 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 dbee33aa9f8..270dfb41c17 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); -- 2.39.5