Re: Performance issue w/ `cl-loop`s `collect...into`

[Tianxiang Xiong <tianxiang.xiong@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 3999 bytes --]

Here's a second, cleaner attempt that separates the `cl--loop-handle-accum`
function into two functions, one to deal with lists and one to deal w/
non-lists.

The tail-tracking optimizing is also applied to `append(ing)` and
`nconc(ing)`.

On Sun, Apr 8, 2018 at 4:29 PM, Tianxiang Xiong <tianxiang.xiong@gmail.com>
wrote:

> One thing I don't understand is the common
>
> (push `(progn (setq ...) t) cl--loop-body)
>
> pattern found in the code. I'm not sure why the `(progn ... t)` is
> necessary. If anyone could explain that I'd add it as a comment.
>
> On Sun, Apr 8, 2018 at 2:13 PM, Stefan Monnier <monnier@iro.umontreal.ca>
> wrote:
>
>> > Avoid O(n^2) nconc-ing by keeping track of tail of collection.
>>
>> I took a quick look at your patch, and it looks pretty good.
>> See comments below.
>>
>>
>>         Stefan
>>
>>
>> >       ((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)))
>> > -                   t)
>> > -                cl--loop-body))))
>> > +      (let ((what (pop cl--loop-args)))
>> > +        (cl-multiple-value-bind (var var-tail)
>>
>> `cl-multiple-value-bind` is the "destructor" corresponding to the
>> `cl-values` "constructor".   Since your code doesn't use `cl-values` it
>> should not use `cl-multiple-value-bind` either (you probably meant to
>> use cl-destructuring-bind instead).
>>
>> > +            (cl--loop-handle-accum nil 'nreverse)
>> > +          (if (eq var cl--loop-accum-var)
>> > +              (push `(progn (push ,what ,var) t) cl--loop-body)
>> > +            (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)))))
>>
>> The cl-loop macro's code lacks comments.  Could you take advantage of
>> "being there" to try and add comments?  E.g. in the above code I see
>> that depending on (eq var cl--loop-accum-var) we end up accumulating in
>> the from or in the back.  Could you add a comments explaining why and
>> mentioning where we correct this discrepancy?
>>
>> > +      (let ((what (pop cl--loop-args)))
>> > +     (cl-destructuring-bind (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))))
>>
>> In the `nconc` case (when (eq var cl--loop-accum-var) is nil) we could
>> also use the `var-tail` to speed up the `nconc`.
>>
>> Also, to avoid the N² behavior for the `append` case, maybe we
>> could/should make it use `copy-sequence`, i.e.
>>
>>     `(nconc ,var-tail (copy-sequence ,what))
>>
>> > -(defun cl--loop-handle-accum (def &optional func) ; uses loop-*
>> > -  (if (eq (car cl--loop-args) 'into)
>> > +(defun cl--loop-handle-accum (def &optional func type) ; uses loop-*
>> > +  (setq type (or type 'list))
>>
>> Please add a docstring explaining whatever you managed to understand of
>> this code, and describing also what this new arg `type` does.
>>
>>
>>
>

[-- Attachment #1.2: Type: text/html, Size: 5414 bytes --]

[-- Attachment #2: 0002-Optimize-collect.into.patch --]
[-- Type: text/x-patch, Size: 5773 bytes --]

From 2d91f7ae9755976363460e58d647e7826db3e549 Mon Sep 17 00:00:00 2001
From: Tianxiang Xiong <tianxiang.xiong@gmail.com>
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..47a5413f49 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 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