From e56fd89c5838013011e729e5a21ff074588f2ad2 Mon Sep 17 00:00:00 2001
From: Tianxiang Xiong <address@hidden>
Date: Sun, 8 Apr 2018 12:36:41 -0700
Subject: [PATCH] Optimize `collect...into`

Avoid O(n^2) nconc-ing by keeping track of tail of collection.
---
 lisp/emacs-lisp/cl-macs.el | 115 ++++++++++++++++++++++++++++++---------------
 1 file changed, 77 insertions(+), 38 deletions(-)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9600230c07..bd4ce1a64b 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1537,31 +1537,34 @@ cl--parse-loop-clause
 	(push `(>= (setq ,temp (1- ,temp)) 0) cl--loop-body)))
 
      ((memq word '(collect collecting))
-      (let ((what (pop cl--loop-args))
-	    (var (cl--loop-handle-accum nil 'nreverse)))
-	(if (eq var cl--loop-accum-var)
-	    (push `(progn (push ,what ,var) t) cl--loop-body)
-	  (push `(progn
-                   (setq ,var (nconc ,var (list ,what)))
+      (let ((what (pop cl--loop-args)))
+        (cl-destructuring-bind (var var-tail) (cl--loop-handle-list-accum nil)
+          (push `(progn
+                   (if (null ,var-tail)
+                       (setq ,var (list ,what) ,var-tail (last ,var))
+                     (setq ,var-tail (setcdr ,var-tail (list ,what))))
                    t)
                 cl--loop-body))))
 
-     ((memq word '(nconc nconcing append appending))
-      (let ((what (pop cl--loop-args))
-	    (var (cl--loop-handle-accum nil 'nreverse)))
-	(push `(progn
-                 (setq ,var
-                       ,(if (eq var cl--loop-accum-var)
-                            `(nconc
-                              (,(if (memq word '(nconc nconcing))
-                                    #'nreverse #'reverse)
-                               ,what)
-                              ,var)
-                          `(,(if (memq word '(nconc nconcing))
-                                 #'nconc #'append)
-                            ,var ,what)))
-                 t)
-              cl--loop-body)))
+     ((memq word '(append appending))
+      (let ((what (pop cl--loop-args)))
+        (cl-destructuring-bind (var var-tail) (cl--loop-handle-list-accum nil)
+          (push `(progn
+                   (if (null ,var-tail)
+                       (setq ,var (copy-sequence ,what) ,var-tail (last ,var))
+                     (setq ,var-tail (setcdr ,var-tail (copy-sequence ,what))))
+                   t)
+                cl--loop-body))))
+
+     ((memq word '(nconc nconcing))
+      (let ((what (pop cl--loop-args)))
+        (cl-destructuring-bind (var var-tail) (cl--loop-handle-list-accum nil)
+          (push `(progn
+                   (if (null ,var-tail)
+                       (setq ,var ,what ,var-tail (last ,var))
+                     (setq ,var-tail (setcdr ,var-tail ,what)))
+                   t)
+                cl--loop-body))))
 
      ((memq word '(concat concating))
       (let ((what (pop cl--loop-args))
@@ -1726,22 +1729,58 @@ cl--loop-let
       `(,(if par 'let 'let*)
         ,(nconc (nreverse temps) (nreverse new)) ,@body))))
 
-(defun cl--loop-handle-accum (def &optional func) ; uses loop-*
-  (if (eq (car cl--loop-args) 'into)
-      (let ((var (cl--pop2 cl--loop-args)))
-	(or (memq var cl--loop-accum-vars)
-	    (progn (push (list (list var def)) cl--loop-bindings)
-		   (push var cl--loop-accum-vars)))
-	var)
-    (or cl--loop-accum-var
-	(progn
-	  (push (list (list
-                       (setq cl--loop-accum-var (make-symbol "--cl-var--"))
-                       def))
-                cl--loop-bindings)
-	  (setq cl--loop-result (if func (list func cl--loop-accum-var)
-                                  cl--loop-accum-var))
-	  cl--loop-accum-var))))
+(defun cl--loop-handle-list-accum (def)
+  "Handle list value accumulation clause.
+
+DEF is the initial value of the accumulation variable.
+
+Returns (VAR VAR-TAIL), where VAR is the accumulation variable
+and VAR-TAIL is the tail of the accumulator."
+  (cl-flet ((tail-symbol (var)
+              (gensym (concat (symbol-name var) "-tail-"))))
+    (cond
+      ((eq (car cl--loop-args) 'into)
+       (let* ((var (cl--pop2 cl--loop-args))
+              (var-tail (tail-symbol var)))
+         (if (memq var cl--loop-accum-vars)
+             (push `((,var-tail ,(last def))) cl--loop-bindings)
+           (push `((,var ,def)) cl--loop-bindings)
+           (push `((,var-tail ,(last def))) cl--loop-bindings)
+           (push var cl--loop-accum-vars))
+         (list var var-tail)))
+
+      (cl--loop-accum-var
+       `(,cl--loop-accum-var ,(tail-symbol cl--loop-accum-var)))
+
+      (t (let* ((var (make-symbol "--cl-var--"))
+                (var-tail (tail-symbol var)))
+           (push `((,var ,def)) cl--loop-bindings)
+           (push `((,var-tail ,(last def))) cl--loop-bindings)
+           (setq cl--loop-accum-var var
+                 cl--loop-result var)
+           (list var var-tail))))))
+
+(defun cl--loop-handle-accum (def)
+  "Handle non-list value accumulation clause.
+
+DEF is the initial value of the accumulation variable.
+
+Returns the accumulation variable VAR."
+  (cond
+    ((eq (car cl--loop-args) 'into)
+     (let* ((var (cl--pop2 cl--loop-args)))
+       (unless (memq var cl--loop-accum-vars)
+         (push `((,var ,def)) cl--loop-bindings)
+         (push var cl--loop-accum-vars))
+       var))
+
+    (cl--loop-accum-var)
+
+    (t (let* ((var (make-symbol "--cl-var--")))
+         (push `((,var ,def)) cl--loop-bindings)
+         (setq cl--loop-accum-var var
+               cl--loop-result var)
+         var))))
 
 (defun cl--loop-build-ands (clauses)
   "Return various representations of (and . CLAUSES).
-- 
2.14.3