A fast native `mapcan'

[Mario Lang]

Hi.

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.

=== 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/db-find.el'
--- lisp/cedet/semantic/db-find.el      2014-01-01 07:43:34 +0000
+++ lisp/cedet/semantic/db-find.el      2014-07-01 19:42:10 +0000
@@ -902,7 +902,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/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.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/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-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/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/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/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-langs.el'
--- lisp/progmodes/cc-langs.el  2014-07-14 23:58:52 +0000
+++ lisp/progmodes/cc-langs.el  2014-07-15 12:10:41 +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
@@ -3196,7 +3189,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 +3197,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-01 19:38:05 +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 ()

=== modified file 'lisp/progmodes/hideif.el'
--- lisp/progmodes/hideif.el    2014-07-21 06:03:08 +0000
+++ lisp/progmodes/hideif.el    2014-07-23 14:50:37 +0000
@@ -1114,8 +1114,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/woman.el'
--- lisp/woman.el       2014-06-05 13:40:54 +0000
+++ lisp/woman.el       2014-07-28 11:44:08 +0000
@@ -434,7 +434,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 +445,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,
  ⡍⠁⠗⠊⠕