From: Tianxiang Xiong <tianxiang.xiong@gmail.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: Emacs developers <emacs-devel@gnu.org>
Subject: Re: Performance issue w/ `cl-loop`s `collect...into`
Date: Sun, 8 Apr 2018 18:10:28 -0700 [thread overview]
Message-ID: <CACMkxizQ=MJMrfRrmUFBp-1Lu+RC8FvUpQLhgnk-7eEUTX809A@mail.gmail.com> (raw)
In-Reply-To: <CACMkxiw5Eag=y8P1FwEFrJNg-TpZmFU3QyJvXHPseS4rjdTgRg@mail.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
next prev parent reply other threads:[~2018-04-09 1:10 UTC|newest]
Thread overview: 21+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-04-08 0:51 Performance issue w/ `cl-loop`s `collect...into` Tianxiang Xiong
2018-04-08 3:26 ` Clément Pit-Claudel
2018-04-08 5:56 ` Tianxiang Xiong
2018-04-08 6:12 ` Clément Pit-Claudel
2018-04-08 8:50 ` Tianxiang Xiong
2018-04-08 13:19 ` Clément Pit-Claudel
2018-04-08 16:07 ` Stefan Monnier
2018-04-08 19:58 ` Tianxiang Xiong
2018-04-08 21:13 ` Stefan Monnier
2018-04-08 23:29 ` Tianxiang Xiong
2018-04-09 1:10 ` Tianxiang Xiong [this message]
2018-04-09 1:59 ` Stefan Monnier
2018-04-09 2:16 ` Tianxiang Xiong
2018-04-09 2:20 ` Stefan Monnier
2018-04-09 3:34 ` Tianxiang Xiong
2018-04-09 3:38 ` Tianxiang Xiong
2018-04-09 12:07 ` Stefan Monnier
2018-04-09 12:22 ` Basil L. Contovounesios
2018-04-09 15:28 ` Tianxiang Xiong
2018-04-09 15:33 ` Tianxiang Xiong
2018-04-14 7:01 ` Tianxiang Xiong
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CACMkxizQ=MJMrfRrmUFBp-1Lu+RC8FvUpQLhgnk-7eEUTX809A@mail.gmail.com' \
--to=tianxiang.xiong@gmail.com \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.