Commit 466ee1b3 authored by Mario Lang's avatar Mario Lang
Browse files

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'.
parent c3223dd5
......@@ -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
......
......@@ -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.
......
......@@ -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)
......
......@@ -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)
......
......@@ -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)
......
......@@ -154,7 +154,6 @@
every
some
mapcon
mapcan
mapl
maplist
map
......
......@@ -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)
......
......@@ -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."
......
......@@ -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)))
......
......@@ -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) '|)
......
......@@ -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)
......
......@@ -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)
......
......@@ -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 ()
......
......@@ -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:
......
......@@ -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 "")))))
......
......@@ -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);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment