* Re: A fast native `mapcan'
2014-07-28 12:56 A fast native `mapcan' Mario Lang
@ 2014-07-31 12:59 ` Mario Lang
2014-08-09 16:43 ` Stefan Monnier
1 sibling, 0 replies; 3+ messages in thread
From: Mario Lang @ 2014-07-31 12:59 UTC (permalink / raw)
To: emacs-devel
Mario Lang <mlang@delysid.org> writes:
> The typical `mapcan' emulation in Emacs Lisp
>
> (apply 'nconc (mapcar fn seq))
>
> is wasting GC time. This is because `mapcar'
> has to build up a full list before it can pass it to `apply',
> and GC has to collect this memory later on, although it was never
> really "used" in Lisp world for anything other then passing args,
> creating unnecessary work for GC.
>
> `cl-mapcan' uses this emulation, plus it implements
> the multi-sequence behaviour from CL. We do not
> have any callers that rely on the multi-sequence behaviour.
>
> So I was thinking: Why not add a native `mapcan'? The native
> impelmentation is approx. twice as fast, because it can pass
> the list of results from Fmapcar to Fnconc directly in C world,
> using an ALLOCA'ed memory area. So GC does not have
> to deal with cleaning up, which is the reason for the speed up.
>
> I have written an impelementation that works very nicely for me.
> Of course I had to remove the alias from `mapcan' to `cl-mapcan', but
> this feels like something we already have: `sort' vs. `cl-sort' for
> instance: `cl-sort' adds keywords not provided by the native Emacs Lisp
> `sort'. Similarily, `cl-mapcan' now provides the
> multi-sequence behaviour, which is not provided by `mapcan',
> since we really never use this, and it keeps the function simple,
> and is actually symmetric to how `mapcar' or `mapc' work.
>
> `cl-mapcan' will also fall-back to the more efficient
> `mapcan' if no additional sequences were provided.
>
> I benchmarked this, and it appears to be almost twice as fast, more or less
> no matter how long the sequence is. Savings all come from
> not having to do as much GC.
>
> Please review and comment. I am going to write a neat ChangeLog entry
> and commit this in the upcoming days, if nobody objects strongly.
Here is an updated version of my proposed patch.
=== modified file 'etc/NEWS'
--- etc/NEWS 2014-07-28 09:39:09 +0000
+++ etc/NEWS 2014-07-28 11:41:32 +0000
@@ -206,6 +206,9 @@
*** New macros `thread-first' and `thread-last' allow threading a form
as the first or last argument of subsequent forms.
+** New built-in function `mapcan' which avoids unnecessary consing (and garbage
+ collection).
+
\f
* Changes in Emacs 24.5 on Non-Free Operating Systems
=== modified file 'lisp/cedet/semantic/analyze/complete.el'
--- lisp/cedet/semantic/analyze/complete.el 2014-01-01 07:43:34 +0000
+++ lisp/cedet/semantic/analyze/complete.el 2014-07-29 20:10:54 +0000
@@ -54,10 +54,9 @@
(let ((origc tags))
;; Accept only tags that are of the datatype specified by
;; the desired classes.
- (setq tags (apply 'nconc ;; All input lists are permutable.
- (mapcar (lambda (class)
- (semantic-find-tags-by-class class origc))
- classlist)))
+ (setq tags (mapcan (lambda (class)
+ (semantic-find-tags-by-class class origc))
+ classlist))
tags))
;;; MAIN completion calculator
=== modified file 'lisp/cedet/semantic/db-find.el'
--- lisp/cedet/semantic/db-find.el 2014-01-01 07:43:34 +0000
+++ lisp/cedet/semantic/db-find.el 2014-07-30 10:17:09 +0000
@@ -333,30 +333,23 @@
(with-current-buffer (semantic-tag-buffer (car tt))
semanticdb-current-database)
semanticdb-current-database))))))
- (apply
- #'nconc
- (mapcar
- (lambda (db)
- (let ((tabs (semanticdb-get-database-tables db))
- (ret nil))
- ;; Only return tables of the same language (major-mode)
- ;; as the current search environment.
- (while tabs
-
- (semantic-throw-on-input 'translate-path-brutish)
-
- (if (semanticdb-equivalent-mode-for-search (car tabs)
- (current-buffer))
- (setq ret (cons (car tabs) ret)))
- (setq tabs (cdr tabs)))
- ret))
- ;; FIXME:
- ;; This should scan the current project directory list for all
- ;; semanticdb files, perhaps handling proxies for them.
- (semanticdb-current-database-list
- (if basedb (oref basedb reference-directory)
- default-directory))))
- ))
+ (mapcan (lambda (db)
+ (let ((ret nil))
+ ;; Only return tables of the same language (major-mode)
+ ;; as the current search environment.
+ (dolist (tab (semanticdb-get-database-tables db) ret)
+
+ (semantic-throw-on-input 'translate-path-brutish)
+
+ (if (semanticdb-equivalent-mode-for-search tab
+ (current-buffer))
+ (push tab ret)))))
+ ;; FIXME:
+ ;; This should scan the current project directory list for all
+ ;; semanticdb files, perhaps handling proxies for them.
+ (semanticdb-current-database-list
+ (if basedb (oref basedb reference-directory)
+ default-directory)))))
(defun semanticdb-find-incomplete-cache-entries-p (cache)
"Are there any incomplete entries in CACHE?"
@@ -902,7 +895,7 @@
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.
=== modified file 'lisp/emacs-lisp/autoload.el'
--- lisp/emacs-lisp/autoload.el 2014-06-30 18:26:34 +0000
+++ lisp/emacs-lisp/autoload.el 2014-07-29 20:16:35 +0000
@@ -751,11 +751,9 @@
(dolist (suf (get-load-suffixes))
(unless (string-match "\\.elc" suf) (push suf tmp)))
(concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
- (files (apply 'nconc
- (mapcar (lambda (dir)
- (directory-files (expand-file-name dir)
- t files-re))
- dirs)))
+ (files (mapcan (lambda (dir)
+ (directory-files (expand-file-name dir) t files-re))
+ dirs))
(done ())
(this-time (current-time))
;; Files with no autoload cookies or whose autoloads go to other
=== modified file 'lisp/emacs-lisp/cl-extra.el'
--- lisp/emacs-lisp/cl-extra.el 2014-03-20 18:16:47 +0000
+++ lisp/emacs-lisp/cl-extra.el 2014-07-01 16:21:52 +0000
@@ -173,7 +173,9 @@
(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)
=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- lisp/emacs-lisp/cl-macs.el 2014-07-21 01:41:59 +0000
+++ lisp/emacs-lisp/cl-macs.el 2014-07-29 20:14:48 +0000
@@ -2048,11 +2048,9 @@
(let* ((temp (make-symbol "--cl-var--")) (n 0))
`(let ((,temp ,form))
(prog1 (setq ,(pop vars) (car ,temp))
- (setq ,@(apply #'nconc
- (mapcar (lambda (v)
- (list v `(nth ,(setq n (1+ n))
- ,temp)))
- vars)))))))))
+ (setq ,@(mapcan (lambda (v)
+ (list v `(nth ,(setq n (1+ n)) ,temp)))
+ vars))))))))
;;; Declarations.
=== modified file 'lisp/emacs-lisp/cl.el'
--- lisp/emacs-lisp/cl.el 2014-04-24 00:28:47 +0000
+++ lisp/emacs-lisp/cl.el 2014-07-01 15:12:48 +0000
@@ -154,7 +154,6 @@
every
some
mapcon
- mapcan
mapl
maplist
map
=== modified file 'lisp/emacs-lisp/rx.el'
--- lisp/emacs-lisp/rx.el 2014-02-10 01:34:22 +0000
+++ lisp/emacs-lisp/rx.el 2014-07-29 20:19:32 +0000
@@ -437,13 +437,11 @@
(setq tail d))))
;; Separate small ranges to single number, and delete dups.
(nconc
- (apply #'nconc
- (mapcar (lambda (e)
- (cond
- ((= (car e) (cdr e)) (list (car e)))
- ((= (1+ (car e)) (cdr e)) (list (car e) (cdr e)))
- ((list e))))
- l))
+ (mapcan (lambda (e)
+ (cond ((= (car e) (cdr e)) (list (car e)))
+ ((= (1+ (car e)) (cdr e)) (list (car e) (cdr e)))
+ ((list e))))
+ l)
(delete-dups str))))
=== modified file 'lisp/epa-mail.el'
--- lisp/epa-mail.el 2014-03-22 22:36:29 +0000
+++ lisp/epa-mail.el 2014-07-30 09:57:16 +0000
@@ -139,23 +139,19 @@
;; Process all the recipients thru the list of GnuPG groups.
;; Expand GnuPG group names to what they stand for.
(setq real-recipients
- (apply #'nconc
- (mapcar
- (lambda (recipient)
+ (mapcan (lambda (recipient)
(or (epg-expand-group config recipient)
(list recipient)))
- real-recipients)))
+ real-recipients))
;; Process all the recipients thru the user's list
;; of encryption aliases.
(setq real-recipients
- (apply #'nconc
- (mapcar
- (lambda (recipient)
+ (mapcan (lambda (recipient)
(let ((tem (assoc recipient epa-mail-aliases)))
(if tem (cdr tem)
(list recipient))))
- real-recipients)))
+ real-recipients))
)))
;;;###autoload
@@ -194,26 +190,23 @@
(setq default-recipients
(epa-mail-default-recipients))
;; Convert recipients to keys.
- (apply
- 'nconc
- (mapcar
- (lambda (recipient)
- (let ((recipient-key
- (epa-mail--find-usable-key
- (epg-list-keys
- (epg-make-context epa-protocol)
- (if (string-match "@" recipient)
- (concat "<" recipient ">")
- recipient))
- 'encrypt)))
- (unless (or recipient-key
- (y-or-n-p
- (format
- "No public key for %s; skip it? "
- recipient)))
- (error "No public key for %s" recipient))
- (if recipient-key (list recipient-key))))
- default-recipients)))))
+ (mapcan (lambda (recipient)
+ (let ((recipient-key
+ (epa-mail--find-usable-key
+ (epg-list-keys
+ (epg-make-context epa-protocol)
+ (if (string-match "@" recipient)
+ (concat "<" recipient ">")
+ recipient))
+ 'encrypt)))
+ (unless (or recipient-key
+ (y-or-n-p
+ (format
+ "No public key for %s; skip it? "
+ recipient)))
+ (error "No public key for %s" recipient))
+ (if recipient-key (list recipient-key))))
+ default-recipients))))
(goto-char (point-min))
(if (search-forward mail-header-separator nil t)
=== modified file 'lisp/epg.el'
--- lisp/epg.el 2014-05-14 17:15:15 +0000
+++ lisp/epg.el 2014-07-29 20:28:46 +0000
@@ -2074,9 +2074,7 @@
(delete-directory tempdir)))))))
(defun epg--args-from-sig-notations (notations)
- (apply #'nconc
- (mapcar
- (lambda (notation)
+ (mapcan (lambda (notation)
(if (and (epg-sig-notation-name notation)
(not (epg-sig-notation-human-readable notation)))
(error "Unreadable"))
@@ -2091,7 +2089,7 @@
(if (epg-sig-notation-critical notation)
(concat "!" (epg-sig-notation-value notation))
(epg-sig-notation-value notation)))))
- notations)))
+ notations))
(defun epg-cancel (context)
(if (buffer-live-p (process-buffer (epg-context-process context)))
@@ -2307,13 +2305,11 @@
(if (memq mode '(nil normal))
"--sign"
"--clearsign")))
- (apply #'nconc
- (mapcar
- (lambda (signer)
+ (mapcan (lambda (signer)
(list "-u"
(epg-sub-key-id
(car (epg-key-sub-key-list signer)))))
- (epg-context-signers context)))
+ (epg-context-signers context))
(epg--args-from-sig-notations
(epg-context-sig-notations context))
(if (epg-data-file plain)
@@ -2407,24 +2403,20 @@
(if recipients '("--encrypt") '("--symmetric"))
(if sign '("--sign"))
(if sign
- (apply #'nconc
- (mapcar
- (lambda (signer)
+ (mapcan (lambda (signer)
(list "-u"
(epg-sub-key-id
(car (epg-key-sub-key-list
signer)))))
- (epg-context-signers context))))
+ (epg-context-signers context)))
(if sign
(epg--args-from-sig-notations
(epg-context-sig-notations context)))
- (apply #'nconc
- (mapcar
- (lambda (recipient)
+ (mapcan (lambda (recipient)
(list "-r"
(epg-sub-key-id
(car (epg-key-sub-key-list recipient)))))
- recipients))
+ recipients)
(if (epg-data-file plain)
(list "--" (epg-data-file plain)))))
;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
=== modified file 'lisp/faces.el'
--- lisp/faces.el 2014-07-12 17:53:29 +0000
+++ lisp/faces.el 2014-07-29 20:31:07 +0000
@@ -1060,12 +1060,11 @@
(`:stipple
(and (memq (window-system frame) '(x ns)) ; No stipple on w32
(mapcar #'list
- (apply #'nconc
- (mapcar (lambda (dir)
- (and (file-readable-p dir)
- (file-directory-p dir)
- (directory-files dir)))
- x-bitmap-file-path)))))
+ (mapcan (lambda (dir)
+ (and (file-readable-p dir)
+ (file-directory-p dir)
+ (directory-files dir)))
+ x-bitmap-file-path))))
(`:inherit
(cons '("none" . nil)
(mapcar #'(lambda (c) (cons (symbol-name c) c))
=== modified file 'lisp/ffap.el'
--- lisp/ffap.el 2014-06-12 02:29:50 +0000
+++ lisp/ffap.el 2014-07-30 09:11:33 +0000
@@ -692,16 +692,11 @@
(setq depth (1- depth))
(cons dir
(and (not (eq depth -1))
- (apply 'nconc
- (mapcar
- (function
- (lambda (d)
- (cond
- ((not (file-directory-p d)) nil)
- ((file-symlink-p d) (list d))
- (t (ffap-all-subdirs-loop d depth)))))
- (directory-files dir t "\\`[^.]")
- )))))
+ (mapcan (lambda (d)
+ (cond ((not (file-directory-p d)) nil)
+ ((file-symlink-p d) (list d))
+ (t (ffap-all-subdirs-loop d depth))))
+ (directory-files dir t "\\`[^.]")))))
(defvar ffap-kpathsea-depth 1
"Bound on depth of subdirectory search in `ffap-kpathsea-expand-path'.
@@ -712,14 +707,12 @@
The subdirs begin with the original directory, and the depth of the
search is bounded by `ffap-kpathsea-depth'. This is intended to mimic
kpathsea, a library used by some versions of TeX."
- (apply 'nconc
- (mapcar
- (function
+ (mapcan (function
(lambda (dir)
(if (string-match "[^/]//\\'" dir)
(ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
(list dir))))
- path)))
+ path))
(defun ffap-locate-file (file nosuffix path)
;; The current version of locate-library could almost replace this,
=== modified file 'lisp/files.el'
--- lisp/files.el 2014-07-28 09:39:09 +0000
+++ lisp/files.el 2014-07-29 20:33:06 +0000
@@ -5322,12 +5322,11 @@
Note that membership in REJECT and KEEP is checked using simple string
comparison."
- (apply #'nconc
- (mapcar (lambda (dir)
- (and (not (member dir reject))
- (or (member dir keep) (file-directory-p dir))
- (list dir)))
- dirs)))
+ (mapcan (lambda (dir)
+ (and (not (member dir reject))
+ (or (member dir keep) (file-directory-p dir))
+ (list dir)))
+ dirs))
\f
(put 'revert-buffer-function 'permanent-local t)
=== modified file 'lisp/gnus/gnus-registry.el'
--- lisp/gnus/gnus-registry.el 2014-05-01 23:55:25 +0000
+++ lisp/gnus/gnus-registry.el 2014-07-01 19:52:02 +0000
@@ -790,8 +790,7 @@
(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)
=== modified file 'lisp/gnus/gnus-score.el'
--- lisp/gnus/gnus-score.el 2014-01-01 07:43:34 +0000
+++ lisp/gnus/gnus-score.el 2014-07-30 09:55:32 +0000
@@ -1248,14 +1248,11 @@
;; We then expand any exclude-file directives.
(setq gnus-scores-exclude-files
(nconc
- (apply
- 'nconc
- (mapcar
- (lambda (sfile)
- (list
- (expand-file-name sfile (file-name-directory file))
- (expand-file-name sfile gnus-kill-files-directory)))
- exclude-files))
+ (mapcan (lambda (sfile)
+ (list
+ (expand-file-name sfile (file-name-directory file))
+ (expand-file-name sfile gnus-kill-files-directory)))
+ exclude-files)
gnus-scores-exclude-files))
(when local
(with-current-buffer gnus-summary-buffer
=== modified file 'lisp/gnus/gnus-sum.el'
--- lisp/gnus/gnus-sum.el 2014-06-22 05:43:58 +0000
+++ lisp/gnus/gnus-sum.el 2014-07-01 19:45:04 +0000
@@ -4797,7 +4797,7 @@
(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."
=== modified file 'lisp/gnus/gnus-util.el'
--- lisp/gnus/gnus-util.el 2014-07-22 06:37:31 +0000
+++ lisp/gnus/gnus-util.el 2014-07-29 22:56:40 +0000
@@ -1766,7 +1766,7 @@
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)))
=== modified file 'lisp/gnus/mailcap.el'
--- lisp/gnus/mailcap.el 2014-03-23 23:13:36 +0000
+++ lisp/gnus/mailcap.el 2014-07-30 09:48:22 +0000
@@ -996,20 +996,16 @@
(mailcap-delete-duplicates
(nconc
(mapcar 'cdr mailcap-mime-extensions)
- (apply
- 'nconc
- (mapcar
- (lambda (l)
- (delq nil
- (mapcar
- (lambda (m)
- (let ((type (cdr (assq 'type (cdr m)))))
- (if (equal (cadr (split-string type "/"))
- "*")
- nil
- type)))
- (cdr l))))
- mailcap-mime-data)))))
+ (mapcan (lambda (l)
+ (delq nil
+ (mapcar
+ (lambda (m)
+ (let ((type (cdr (assq 'type (cdr m)))))
+ (if (string-equal (cadr (split-string type "/")) "*")
+ nil
+ type)))
+ (cdr l))))
+ mailcap-mime-data))))
;;;
;;; Useful supplementary functions
=== modified file 'lisp/gnus/mml-smime.el'
--- lisp/gnus/mml-smime.el 2014-03-23 23:13:36 +0000
+++ lisp/gnus/mml-smime.el 2014-07-29 22:50:35 +0000
@@ -490,16 +490,14 @@
recipient-key)
(unless recipients
(setq recipients
- (apply #'nconc
- (mapcar
- (lambda (recipient)
+ (mapcan (lambda (recipient)
(or (epg-expand-group config recipient)
(list recipient)))
(split-string
(or (message-options-get 'message-recipients)
(message-options-set 'message-recipients
(read-string "Recipients: ")))
- "[ \f\t\n\r\v,]+"))))
+ "[ \f\t\n\r\v,]+")))
(when mml-smime-encrypt-to-self
(unless signer-names
(error "Neither message sender nor mml-smime-signers are set"))
=== modified file 'lisp/gnus/mml1991.el'
--- lisp/gnus/mml1991.el 2014-03-23 23:13:36 +0000
+++ lisp/gnus/mml1991.el 2014-07-29 22:51:03 +0000
@@ -404,11 +404,10 @@
(functionp #'epg-expand-group))
(setq config (epg-configuration)
recipients
- (apply #'nconc
- (mapcar (lambda (recipient)
- (or (epg-expand-group config recipient)
- (list recipient)))
- recipients))))
+ (mapcan (lambda (recipient)
+ (or (epg-expand-group config recipient)
+ (list recipient)))
+ recipients)))
(if (eq mm-encrypt-option 'guided)
(setq recipients
(epa-select-keys context "Select recipients for encryption.
=== modified file 'lisp/gnus/mml2015.el'
--- lisp/gnus/mml2015.el 2014-05-09 06:43:52 +0000
+++ lisp/gnus/mml2015.el 2014-07-29 20:02:57 +0000
@@ -1155,16 +1155,14 @@
recipient-key signer-key)
(unless recipients
(setq recipients
- (apply #'nconc
- (mapcar
- (lambda (recipient)
+ (mapcan (lambda (recipient)
(or (epg-expand-group config recipient)
(list (concat "<" recipient ">"))))
(split-string
(or (message-options-get 'message-recipients)
(message-options-set 'message-recipients
(read-string "Recipients: ")))
- "[ \f\t\n\r\v,]+"))))
+ "[ \f\t\n\r\v,]+")))
(when mml2015-encrypt-to-self
(unless signer-names
(error "Neither message sender nor mml2015-signers are set"))
=== modified file 'lisp/gnus/nnmail.el'
--- lisp/gnus/nnmail.el 2014-03-23 23:13:36 +0000
+++ lisp/gnus/nnmail.el 2014-07-01 19:46:17 +0000
@@ -1403,7 +1403,7 @@
;; Builtin & operation.
((eq (car split) '&)
- (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
+ (mapcan 'nnmail-split-it (cdr split)))
;; Builtin | operation.
((eq (car split) '|)
=== modified file 'lisp/gnus/pop3.el'
--- lisp/gnus/pop3.el 2014-02-10 01:34:22 +0000
+++ lisp/gnus/pop3.el 2014-07-01 19:48:13 +0000
@@ -406,8 +406,8 @@
(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)
=== modified file 'lisp/ido.el'
--- lisp/ido.el 2014-03-03 02:27:08 +0000
+++ lisp/ido.el 2014-07-30 10:02:26 +0000
@@ -4670,24 +4670,23 @@
(alternatives
(apply
#'concat
- (cdr (apply
- #'nconc
- (mapcar
- (lambda (com)
- (setq com (ido-name com))
- (setq items (1- items))
- (cond
- ((< items 0) ())
- ((= items 0) (list (nth 3 ido-decorations))) ; " | ..."
- (t
- (list (or ido-separator (nth 2 ido-decorations)) ; " | "
- (let ((str (substring com 0)))
- (if (and ido-use-faces
- (not (string= str first))
- (ido-final-slash str))
- (put-text-property 0 (length str) 'face 'ido-subdir str))
- str)))))
- comps))))))
+ (cdr (mapcan
+ (lambda (com)
+ (setq com (ido-name com)
+ items (1- items))
+ (cond ((< items 0)
+ ())
+ ((= items 0)
+ (list (nth 3 ido-decorations))) ; " | ..."
+ (t
+ (list (or ido-separator (nth 2 ido-decorations)) ; " | "
+ (let ((str (substring com 0)))
+ (if (and ido-use-faces
+ (not (string= str first))
+ (ido-final-slash str))
+ (put-text-property 0 (length str) 'face 'ido-subdir str))
+ str)))))
+ comps)))))
(concat
;; put in common completion item -- what you get by pressing tab
=== modified file 'lisp/info-xref.el'
--- lisp/info-xref.el 2014-01-01 07:43:34 +0000
+++ lisp/info-xref.el 2014-07-29 22:51:46 +0000
@@ -347,9 +347,7 @@
in the path."
(info-initialize) ;; establish Info-directory-list
- (apply 'nconc
- (mapcar
- (lambda (dir)
+ (mapcar (lambda (dir)
(let ((result nil))
(dolist (name (directory-files
dir
@@ -362,7 +360,7 @@
(not (info-xref-subfile-p name)))
(push name result)))
(nreverse result)))
- (append Info-directory-list Info-additional-directory-list))))
+ (append Info-directory-list Info-additional-directory-list)))
(defun info-xref-check-list (filename-list)
"Check external references in info documents in FILENAME-LIST."
=== modified file 'lisp/info.el'
--- lisp/info.el 2014-06-25 10:36:51 +0000
+++ lisp/info.el 2014-07-29 20:38:23 +0000
@@ -194,14 +194,12 @@
'("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/"
"emacs/" "lib/" "lib/emacs/"))
(standard-info-dirs
- (apply #'nconc
- (mapcar (lambda (pfx)
- (let ((dirs
- (mapcar (lambda (sfx)
- (concat pfx sfx "info/"))
- suffixes)))
- (prune-directory-list dirs)))
- prefixes)))
+ (mapcan (lambda (pfx)
+ (let ((dirs (mapcar (lambda (sfx)
+ (concat pfx sfx "info/"))
+ suffixes)))
+ (prune-directory-list dirs)))
+ prefixes))
;; If $(prefix)/share/info is not one of the standard info
;; directories, they are probably installing an experimental
;; version of Emacs, so make sure that experimental version's Info
=== modified file 'lisp/mouse.el'
--- lisp/mouse.el 2014-07-21 01:38:21 +0000
+++ lisp/mouse.el 2014-07-23 14:50:37 +0000
@@ -1584,7 +1584,7 @@
(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)))))
+ (mapcan 'cddr split-by-major-mode))))
(and others-list
(setq subdivided-menus
(cons (cons "Others" others-list)
=== modified file 'lisp/msb.el'
--- lisp/msb.el 2014-02-10 01:34:22 +0000
+++ lisp/msb.el 2014-07-30 09:42:50 +0000
@@ -507,14 +507,12 @@
;; ((DIR-1 BUFFER-1) (DIR-2 BUFFER-2) ...)
;; sorted on DIR-x
(sort
- (apply #'nconc
- (mapcar
- (lambda (buffer)
+ (mapcan (lambda (buffer)
(let ((file-name (expand-file-name
(buffer-file-name buffer))))
(when file-name
(list (cons (msb--strip-dir file-name) buffer)))))
- list))
+ list)
(lambda (item1 item2)
(string< (car item1) (car item2))))))
;; Now clump buffers together that have the same directory name
@@ -523,24 +521,21 @@
(let ((dir nil)
(buffers nil))
(nconc
- (apply
- #'nconc
- (mapcar (lambda (item)
- (cond
- ((equal dir (car item))
- ;; The same dir as earlier:
- ;; Add to current list of buffers.
- (push (cdr item) buffers)
- ;; This item should not be added to list
- nil)
- (t
- ;; New dir
- (let ((result (and dir (cons dir buffers))))
- (setq dir (car item))
- (setq buffers (list (cdr item)))
- ;; Add the last result the list.
- (and result (list result))))))
- buffer-alist))
+ (mapcan (lambda (item)
+ (cond ((equal dir (car item))
+ ;; The same dir as earlier:
+ ;; Add to current list of buffers.
+ (push (cdr item) buffers)
+ ;; This item should not be added to list
+ nil)
+ (t
+ ;; New dir
+ (let ((result (and dir (cons dir buffers))))
+ (setq dir (car item))
+ (setq buffers (list (cdr item)))
+ ;; Add the last result the list.
+ (and result (list result))))))
+ buffer-alist)
;; Add the last result to the list
(list (cons dir buffers))))))
@@ -790,9 +785,7 @@
(first-time-p t)
old-car)
(nconc
- (apply #'nconc
- (mapcar
- (lambda (item)
+ (mapcan (lambda (item)
(cond
(first-time-p
(push (cdr item) same)
@@ -810,7 +803,7 @@
(list (cons tmp-old-car (nreverse tmp-same))))))
(sort alist (lambda (item1 item2)
(funcall sort-predicate
- (car item1) (car item2))))))
+ (car item1) (car item2)))))
(list (cons old-car (nreverse same)))))))
@@ -1015,9 +1008,7 @@
(not (numberp msb-separator-diff)))
sorted-list
(let ((last-key nil))
- (apply #'nconc
- (mapcar
- (lambda (item)
+ (mapcan (lambda (item)
(cond
((and msb-separator-diff
last-key
@@ -1029,7 +1020,7 @@
(t
(setq last-key (car item))
(list item))))
- sorted-list)))))
+ sorted-list))))
(defun msb--split-menus-2 (list mcount result)
(cond
=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el 2014-07-01 18:48:24 +0000
+++ lisp/net/gnutls.el 2014-07-01 18:57:21 +0000
@@ -211,7 +211,7 @@
t)
;; if a list, look for hostname matches
((listp gnutls-verify-error)
- (cl-mapcan
+ (mapcan
(lambda (check)
(when (string-match (car check) hostname)
(copy-sequence (cdr check))))
=== modified file 'lisp/progmodes/cc-defs.el'
--- lisp/progmodes/cc-defs.el 2014-07-14 23:58:52 +0000
+++ lisp/progmodes/cc-defs.el 2014-07-29 19:57:29 +0000
@@ -2050,12 +2050,11 @@
;; are no file dependencies needed.
(setq source-files (nreverse
;; Reverse to get the right load order.
- (apply 'nconc
- (mapcar (lambda (elem)
- (if (eq file (car elem))
- nil ; Exclude our own file.
- (list (car elem))))
- (get sym 'source))))))
+ (mapcan (lambda (elem)
+ (if (eq file (car elem))
+ nil ; Exclude our own file.
+ (list (car elem))))
+ (get sym 'source)))))
;; Make some effort to do a compact call to
;; `c-get-lang-constant' since it will be compiled in.
=== modified file 'lisp/progmodes/cc-engine.el'
--- lisp/progmodes/cc-engine.el 2014-06-29 11:26:47 +0000
+++ lisp/progmodes/cc-engine.el 2014-07-29 19:55:47 +0000
@@ -152,13 +152,12 @@
(defmacro c-declare-lang-variables ()
`(progn
- ,@(apply 'nconc
- (mapcar (lambda (init)
- `(,(if (elt init 2)
- `(defvar ,(car init) nil ,(elt init 2))
- `(defvar ,(car init) nil))
- (make-variable-buffer-local ',(car init))))
- (cdr c-lang-variable-inits)))))
+ ,@(mapcan (lambda (init)
+ `(,(if (elt init 2)
+ `(defvar ,(car init) nil ,(elt init 2))
+ `(defvar ,(car init) nil))
+ (make-variable-buffer-local ',(car init))))
+ (cdr c-lang-variable-inits))))
(c-declare-lang-variables)
\f
=== modified file 'lisp/progmodes/cc-fonts.el'
--- lisp/progmodes/cc-fonts.el 2014-01-01 07:43:34 +0000
+++ lisp/progmodes/cc-fonts.el 2014-07-29 19:52:41 +0000
@@ -1975,9 +1975,7 @@
(cdr-safe (or (assq c-buffer-is-cc-mode c-doc-comment-style)
(assq 'other c-doc-comment-style)))
c-doc-comment-style))
- (list (nconc (apply 'nconc
- (mapcar
- (lambda (doc-style)
+ (list (nconc (mapcan (lambda (doc-style)
(let ((sym (intern
(concat (symbol-name doc-style)
"-font-lock-keywords"))))
@@ -1987,7 +1985,7 @@
(append (eval sym) nil)))))
(if (listp doc-keywords)
doc-keywords
- (list doc-keywords))))
+ (list doc-keywords)))
base-list)))
;; Kludge: If `c-font-lock-complex-decl-prepare' is on the list we
=== modified file 'lisp/progmodes/cc-langs.el'
--- lisp/progmodes/cc-langs.el 2014-07-14 23:58:52 +0000
+++ lisp/progmodes/cc-langs.el 2014-07-29 19:50:45 +0000
@@ -253,20 +253,19 @@
(unless xlate
(setq xlate 'identity))
(c-with-syntax-table (c-lang-const c-mode-syntax-table)
- (cl-delete-duplicates
- (cl-mapcan (lambda (opgroup)
+ (delete-dups
+ (mapcan (lambda (opgroup)
(when (if (symbolp (car opgroup))
(when (funcall opgroup-filter (car opgroup))
(setq opgroup (cdr opgroup))
t)
t)
- (cl-mapcan (lambda (op)
+ (mapcan (lambda (op)
(when (funcall op-filter op)
(let ((res (funcall xlate op)))
(if (listp res) res (list res)))))
opgroup)))
- ops)
- :test 'equal))))
+ ops)))))
\f
;;; Various mode specific values that aren't language related.
@@ -2495,14 +2494,8 @@
lang-const-list (cdar alist)
alist (cdr alist))
(setplist (intern kwd obarray)
- ;; Emacs has an odd bug that causes `mapcan' to fail
- ;; with unintelligible errors. (XEmacs works.)
- ;;(mapcan (lambda (lang-const)
- ;; (list lang-const t))
- ;; lang-const-list)
- (apply 'nconc (mapcar (lambda (lang-const)
- (list lang-const t))
- lang-const-list))))
+ (mapcan (lambda (lang-const) (list lang-const t))
+ lang-const-list)))
obarray))
(c-lang-defconst c-regular-keywords-regexp
@@ -2918,17 +2911,15 @@
(when (boundp (c-mode-symbol "font-lock-extra-types"))
(c-mode-var "font-lock-extra-types")))
(regexp-strings
- (apply 'nconc
- (mapcar (lambda (re)
+ (mapcan (lambda (re)
(when (string-match "[][.*+?^$\\]" re)
(list re)))
- extra-types)))
+ extra-types))
(plain-strings
- (apply 'nconc
- (mapcar (lambda (re)
+ (mapcan (lambda (re)
(unless (string-match "[][.*+?^$\\]" re)
(list re)))
- extra-types))))
+ extra-types)))
(concat "\\<\\("
(c-concat-separated
(append (list (c-make-keywords-re nil
@@ -3196,7 +3187,7 @@
;; `c-lang-const' will expand to the evaluated
;; constant immediately in `macroexpand-all'
;; below.
- (cl-mapcan
+ (mapcan
(lambda (init)
`(current-var ',(car init)
,(car init) ,(macroexpand-all
@@ -3204,8 +3195,8 @@
;; Note: The following `append' copies the
;; first argument. That list is small, so
;; this doesn't matter too much.
- (append (cdr c-emacs-variable-inits)
- (cdr c-lang-variable-inits)))))
+ (append (cdr c-emacs-variable-inits)
+ (cdr c-lang-variable-inits)))))
;; This diagnostic message isn't useful for end
;; users, so it's disabled.
=== modified file 'lisp/progmodes/gud.el'
--- lisp/progmodes/gud.el 2014-02-10 01:34:22 +0000
+++ lisp/progmodes/gud.el 2014-07-30 09:39:19 +0000
@@ -1881,10 +1881,10 @@
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 ()
@@ -2086,11 +2086,7 @@
(defun gud-jdb-build-class-source-alist (sources)
(setq gud-jdb-analysis-buffer (get-buffer-create " *gud-jdb-scratch*"))
(prog1
- (apply
- 'nconc
- (mapcar
- 'gud-jdb-build-class-source-alist-for-file
- sources))
+ (mapcan 'gud-jdb-build-class-source-alist-for-file sources)
(kill-buffer gud-jdb-analysis-buffer)
(setq gud-jdb-analysis-buffer nil)))
=== modified file 'lisp/progmodes/hideif.el'
--- lisp/progmodes/hideif.el 2014-07-21 06:03:08 +0000
+++ lisp/progmodes/hideif.el 2014-07-29 19:47:33 +0000
@@ -677,10 +677,7 @@
(defun hif-flatten (l)
"Flatten a tree."
- (apply #'nconc
- (mapcar (lambda (x) (if (listp x)
- (hif-flatten x)
- (list x))) l)))
+ (mapcan (lambda (x) (if (listp x) (hif-flatten x) (list x))) l))
(defun hif-expand-token-list (tokens &optional macroname expand_list)
"Perform expansion on TOKENS till everything expanded.
@@ -1114,8 +1111,7 @@
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:
=== modified file 'lisp/progmodes/idlwave.el'
--- lisp/progmodes/idlwave.el 2014-06-29 02:17:17 +0000
+++ lisp/progmodes/idlwave.el 2014-07-30 10:40:30 +0000
@@ -5165,19 +5165,15 @@
(defun idlwave-get-routine-info-from-buffers (buffers)
"Call `idlwave-get-buffer-routine-info' on idlwave-mode buffers in BUFFERS."
- (let (buf routine-lists res)
- (save-excursion
- (while (setq buf (pop buffers))
- (set-buffer buf)
- (if (and (derived-mode-p 'idlwave-mode)
- buffer-file-name)
- ;; yes, this buffer has the right mode.
- (progn (setq res (condition-case nil
- (idlwave-get-buffer-routine-info)
- (error nil)))
- (push res routine-lists)))))
- ;; Concatenate the individual lists and return the result
- (apply 'nconc routine-lists)))
+ (mapcan (lambda (buf)
+ (with-current-buffer buf
+ (when (and (derived-mode-p 'idlwave-mode)
+ buffer-file-name)
+ ;; yes, this buffer has the right mode.
+ (condition-case nil
+ (idlwave-get-buffer-routine-info)
+ (error nil)))))
+ buffers))
(defun idlwave-get-buffer-routine-info ()
"Scan the current buffer for routine info. Return (PRO-LIST FUNC-LIST)."
=== modified file 'lisp/progmodes/python.el'
--- lisp/progmodes/python.el 2014-07-28 21:07:10 +0000
+++ lisp/progmodes/python.el 2014-07-30 09:53:26 +0000
@@ -3717,26 +3717,23 @@
(\"decorator.wrap\" . 353)
(\"decorator.wrapped_f\" . 393))"
;; Inspired by imenu--flatten-index-alist removed in revno 21853.
- (apply
- 'nconc
- (mapcar
- (lambda (item)
- (let ((name (if prefix
- (concat prefix "." (car item))
- (car item)))
- (pos (cdr item)))
- (cond ((or (numberp pos) (markerp pos))
- (list (cons name pos)))
- ((listp pos)
- (cons
- (cons name (cdar pos))
- (python-imenu-create-flat-index (cddr item) name))))))
- (or alist
- (let* ((fn (lambda (_type name) name))
- (python-imenu-format-item-label-function fn)
- (python-imenu-format-parent-item-label-function fn)
- (python-imenu-format-parent-item-jump-label-function fn))
- (python-imenu-create-index))))))
+ (mapcan (lambda (item)
+ (let ((name (if prefix
+ (concat prefix "." (car item))
+ (car item)))
+ (pos (cdr item)))
+ (cond ((or (numberp pos) (markerp pos))
+ (list (cons name pos)))
+ ((listp pos)
+ (cons
+ (cons name (cdar pos))
+ (python-imenu-create-flat-index (cddr item) name))))))
+ (or alist
+ (let* ((fn (lambda (_type name) name))
+ (python-imenu-format-item-label-function fn)
+ (python-imenu-format-parent-item-label-function fn)
+ (python-imenu-format-parent-item-jump-label-function fn))
+ (python-imenu-create-index)))))
\f
;;; Misc helpers
@@ -4140,14 +4137,12 @@
that takes one argument (a full path) and returns non-nil for
allowed files."
(let ((dir-name (file-name-as-directory dir)))
- (apply #'nconc
- (mapcar (lambda (file-name)
- (let ((full-file-name (expand-file-name file-name dir-name)))
- (when (and
- (not (member file-name '("." "..")))
- (funcall (or predicate #'identity) full-file-name))
- (list full-file-name))))
- (directory-files dir-name)))))
+ (mapcan (lambda (file-name)
+ (let ((full-file-name (expand-file-name file-name dir-name)))
+ (when (and (not (member file-name '("." "..")))
+ (funcall (or predicate #'identity) full-file-name))
+ (list full-file-name))))
+ (directory-files dir-name))))
(defun python-util-list-packages (dir &optional max-depth)
"List packages in DIR, limited by MAX-DEPTH.
=== modified file 'lisp/subr.el'
--- lisp/subr.el 2014-07-11 09:09:54 +0000
+++ lisp/subr.el 2014-07-29 19:41:09 +0000
@@ -315,12 +315,10 @@
(unless parent (setq parent 'error))
(let ((conditions
(if (consp parent)
- (apply #'nconc
- (mapcar (lambda (parent)
- (cons parent
- (or (get parent 'error-conditions)
+ (mapcan (lambda (parent)
+ (cons parent (or (get parent 'error-conditions)
(error "Unknown signal `%s'" parent))))
- parent))
+ parent)
(cons parent (get parent 'error-conditions)))))
(put name 'error-conditions
(delete-dups (copy-sequence (cons name conditions))))
=== modified file 'lisp/textmodes/artist.el'
--- lisp/textmodes/artist.el 2014-01-01 07:43:34 +0000
+++ lisp/textmodes/artist.el 2014-07-30 09:37:51 +0000
@@ -1552,26 +1552,20 @@
(defun artist-compute-key-compl-table (menu-table)
"Compute completion table from MENU-TABLE, suitable for `completing-read'."
- (apply
- 'nconc
- (remq nil
- (mapcar
- (lambda (element)
- (let ((element-tag (artist-mt-get-tag element)))
- (cond ((eq element-tag 'graphics-operation)
- (let* ((info-part (artist-mt-get-info-part element))
- (unshifted (artist-go-get-unshifted info-part))
- (shifted (artist-go-get-shifted info-part))
- (unshifted-kwd (artist-go-get-keyword unshifted))
- (shifted-kwd (artist-go-get-keyword shifted)))
- (list (list unshifted-kwd) (list shifted-kwd))))
- ((eq element-tag 'menu)
- (let* ((info-part (artist-mt-get-info-part element))
- (items (artist-mn-get-items info-part)))
- (artist-compute-key-compl-table items)))
- (t
- nil))))
- menu-table))))
+ (mapcan (lambda (element)
+ (let ((element-tag (artist-mt-get-tag element)))
+ (cond ((eq element-tag 'graphics-operation)
+ (let* ((info-part (artist-mt-get-info-part element))
+ (unshifted (artist-go-get-unshifted info-part))
+ (shifted (artist-go-get-shifted info-part))
+ (unshifted-kwd (artist-go-get-keyword unshifted))
+ (shifted-kwd (artist-go-get-keyword shifted)))
+ (list (list unshifted-kwd) (list shifted-kwd))))
+ ((eq element-tag 'menu)
+ (let* ((info-part (artist-mt-get-info-part element))
+ (items (artist-mn-get-items info-part)))
+ (artist-compute-key-compl-table items))))))
+ menu-table))
;
=== modified file 'lisp/vc/vc-hg.el'
--- lisp/vc/vc-hg.el 2014-06-08 00:35:27 +0000
+++ lisp/vc/vc-hg.el 2014-07-29 19:37:00 +0000
@@ -680,8 +680,7 @@
(apply #'vc-hg-command
nil 0 nil
"push"
- (apply 'nconc
- (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
+ (mapcan (lambda (arg) (list "-r" arg)) marked-list))
(error "No log entries selected for push"))))
(defvar vc-hg-error-regexp-alist nil
@@ -712,9 +711,7 @@
(apply #'vc-hg-command
nil 0 nil
"pull"
- (apply 'nconc
- (mapcar (lambda (arg) (list "-r" arg))
- marked-list)))
+ (mapcan (lambda (arg) (list "-r" arg)) marked-list))
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root)))
(command "pull")
=== modified file 'lisp/woman.el'
--- lisp/woman.el 2014-06-05 13:40:54 +0000
+++ lisp/woman.el 2014-07-29 13:21:02 +0000
@@ -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 @@
(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 @@
(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 "")))))
=== modified file 'src/fns.c'
--- src/fns.c 2014-07-26 13:17:25 +0000
+++ src/fns.c 2014-07-27 12:41:13 +0000
@@ -2441,6 +2441,29 @@
return ret;
}
+DEFUN ("mapcan", Fmapcan, Smapcan, 2, 2, 0,
+ doc: /* Apply FUNCTION to each element of SEQUENCE, and nconc the results.
+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;
+}
+
DEFUN ("mapc", Fmapc, Smapc, 2, 2, 0,
doc: /* Apply FUNCTION to each element of SEQUENCE for side effects only.
Unlike `mapcar', don't accumulate the results. Return SEQUENCE.
@@ -5006,6 +5029,7 @@
defsubr (&Sclear_string);
defsubr (&Snconc);
defsubr (&Smapcar);
+ defsubr (&Smapcan);
defsubr (&Smapc);
defsubr (&Smapconcat);
defsubr (&Syes_or_no_p);
--
CYa,
⡍⠁⠗⠊⠕
^ permalink raw reply [flat|nested] 3+ messages in thread