From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Daniel Colascione Newsgroups: gmane.emacs.devel Subject: [PATCH] use tail pointer for LOOP (Was: Re: O(N^2) behavior in LOOP) Date: Sat, 29 May 2010 19:58:32 -0400 Organization: Censorship Research Center Message-ID: <4C01AA28.6030002@censorshipresearch.org> References: <4C018D79.7040409@censorshipresearch.org> <4C018FD3.1020305@censorshipresearch.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/signed; micalg=pgp-sha1; protocol="application/pgp-signature"; boundary="------------enig1E5283F472BAE658EDAB1F1F" X-Trace: dough.gmane.org 1275177544 7967 80.91.229.12 (29 May 2010 23:59:04 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sat, 29 May 2010 23:59:04 +0000 (UTC) Cc: Emacs development discussions To: Geoff Gole Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun May 30 01:59:02 2010 connect(): No such file or directory Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1OIVvi-0007P2-1Z for ged-emacs-devel@m.gmane.org; Sun, 30 May 2010 01:59:02 +0200 Original-Received: from localhost ([127.0.0.1]:33667 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OIVvh-000146-Fi for ged-emacs-devel@m.gmane.org; Sat, 29 May 2010 19:59:01 -0400 Original-Received: from [140.186.70.92] (port=35424 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OIVvb-00012e-LG for emacs-devel@gnu.org; Sat, 29 May 2010 19:58:56 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1OIVva-0003ia-97 for emacs-devel@gnu.org; Sat, 29 May 2010 19:58:55 -0400 Original-Received: from haystack.austinheap.com ([70.32.98.68]:33971 helo=haystacknetwork.com) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1OIVva-0003iU-5Z for emacs-devel@gnu.org; Sat, 29 May 2010 19:58:54 -0400 User-Agent: Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.6; en-US; rv:1.9.1.9) Gecko/20100317 Thunderbird/3.0.4 In-Reply-To: X-Enigmail-Version: 1.0.1 X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:125352 Archived-At: This is an OpenPGP/MIME signed message (RFC 2440 and 3156) --------------enig1E5283F472BAE658EDAB1F1F Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: quoted-printable We do this only for the anonymous-variable case, but it's still an improvement. --- /Applications/Emacs.app/Contents/Resources/lisp/emacs-lisp/cl-macs.el 2008-01-06 20:07:45.000000000 -0500 +++ cl-macs2.el 2010-05-29 19:52:09.000000000 -0400 @@ -625,6 +625,7 @@ (defvar loop-initially) (defvar loop-map-form) (defvar loop-name) (defvar loop-result) (defvar loop-result-explicit) (defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs) +(defvar loop-accum-tailptr) (defmacro loop (&rest args) "The Common Lisp `loop' macro. @@ -650,7 +651,8 @@ (loop-accum-var nil) (loop-accum-vars nil) (loop-initially nil) (loop-finally nil) (loop-map-form nil) (loop-first-flag nil) - (loop-destr-temps nil) (loop-symbol-macs nil)) + (loop-destr-temps nil) (loop-symbol-macs nil) + (loop-accum-tailptr nil)) (setq args (append args '(cl-end-loop))) (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause)) (if loop-finish-flag @@ -984,28 +986,49 @@ ((memq word '(collect collecting)) (let ((what (pop args)) - (var (cl-loop-handle-accum nil 'nreverse))) + (var (cl-loop-handle-accum nil :use-tailptr))) (if (eq var loop-accum-var) - (push (list 'progn (list 'push what var) t) loop-body) - (push (list 'progn - (list 'setq var (list 'nconc var (list 'list what))) - t) loop-body)))) + ;; Anonymous case; we can use a tail pointer here + (push `(progn + (if ,var + (setq ,loop-accum-tailptr + (setcdr ,loop-accum-tailptr (list ,what))= ) + (setq ,var (list ,what)) + (setq ,loop-accum-tailptr ,var)) + t) + loop-body) + + ;; 'into' case. We have to use nconc here instead of + ;; tail-ptr setup or push-then-nreverse because user code + ;; can inspect and modify the given variable at any time. + (push `(progn + (setq ,var (nconc ,var (list ,what))) + t) + loop-body)))) - ((memq word '(nconc nconcing append appending)) + ((memq word '(nconc noncing append appending)) (let ((what (pop args)) - (var (cl-loop-handle-accum nil 'nreverse))) - (push (list 'progn - (list 'setq var - (if (eq var loop-accum-var) - (list 'nconc - (list (if (memq word '(nconc nconcing)) - 'nreverse 'reverse) - what) - var) - (list (if (memq word '(nconc nconcing)) - 'nconc 'append) - var what))) t) loop-body))) + (var (cl-loop-handle-accum nil :use-tailptr))) + (push (if (eq var loop-accum-var) + (let ((func (if (memq word '(nconc noncing)) + 'identity 'copy-sequence))) + + ;; use tail pointer + `(if ,var + (setq ,loop-accum-tailptr + (last (setcdr ,loop-accum-tailptr + (,func ,what)))) + (setq ,var (,func ,what)) + (setq ,loop-accum-tailptr (last ,var)))) + + ;; visible variable; no tail pointer + (let ((func + (if (memq word '(nconc nconcing)) 'nconc append))= ) + `(setq ,var (,func ,var ,what)))) + loop-body) + (push t loop-body))) + ((memq word '(concat concating)) (let ((what (pop args)) (var (cl-loop-handle-accum ""))) @@ -1144,20 +1167,36 @@ (list* (if par 'let 'let*) (nconc (nreverse temps) (nreverse new)) body)))) -(defun cl-loop-handle-accum (def &optional func) ; uses args, loop-* - (if (eq (car args) 'into) - (let ((var (cl-pop2 args))) - (or (memq var loop-accum-vars) - (progn (push (list (list var def)) loop-bindings) - (push var loop-accum-vars))) - var) - (or loop-accum-var - (progn - (push (list (list (setq loop-accum-var (make-symbol "--cl-var--")) de= f)) - loop-bindings) - (setq loop-result (if func (list func loop-accum-var) - loop-accum-var)) - loop-accum-var)))) +(defun cl-loop-handle-accum (def &optional listp) ; uses args, loop-* + (cond ((eq (car args) 'into) ; accumulate into visible variable + (let ((var (cl-pop2 args))) + (or (memq var loop-accum-vars) + (progn (push (list (list var def)) loop-bindings) + (push var loop-accum-vars))) + var)) + + ;; Otherwise, if we've already configured our anonymous + ;; accumulation variable so just return it. + (loop-accum-var) + + ;; We're accumulating a list, so in addition to setting up + ;; loop-accum-var, set up loop-accum-tailptr. + (listp + (push (list (list (setq loop-accum-var (make-symbol "--cl-accum--")) def)) + loop-bindings) + (push (list (list (setq loop-accum-tailptr + (make-symbol "--cl-tailptr--")) def)) + loop-bindings) + (setq loop-result loop-accum-var) + loop-accum-var) + + ;; We're accumulating something else. + (t + (push (list (list (setq loop-accum-var (make-symbol "--cl-var--")) def)) + loop-bindings) + (setq loop-result (if func (list func loop-accum-var) + loop-accum-var)) + loop-accum-var))) (defun cl-loop-build-ands (clauses) (let ((ands nil) --------------enig1E5283F472BAE658EDAB1F1F Content-Type: application/pgp-signature; name="signature.asc" Content-Description: OpenPGP digital signature Content-Disposition: attachment; filename="signature.asc" -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (Darwin) iEYEARECAAYFAkwBqioACgkQ17c2LVA10VtJrACgzxlXkbeCZK24rai/N4nC5Pin OJ0AoLeAugJUBMV/oECGxI290Es1hKxY =s0cu -----END PGP SIGNATURE----- --------------enig1E5283F472BAE658EDAB1F1F--