emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: A fast native `mapcan'


From: Mario Lang
Subject: Re: A fast native `mapcan'
Date: 2014年7月31日 14:59:33 +0200
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/24.4.50 (gnu/linux)

Mario Lang <address@hidden> 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).
+
 * 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))
 
 (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)
 
=== 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)))))
 
 ;;; 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)))))
 
 ;;; 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,
 ⡍⠁⠗⠊⠕

reply via email to

[Prev in Thread] Current Thread [Next in Thread]

AltStyle によって変換されたページ (->オリジナル) /