[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] use tail pointer for LOOP (Was: Re: O(N^2) behavior in LOOP)
From: |
Daniel Colascione |
Subject: |
[PATCH] use tail pointer for LOOP (Was: Re: O(N^2) behavior in LOOP) |
Date: |
Sat, 29 May 2010 19:58:32 -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 |
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--"))
def))
- 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)
signature.asc
Description: OpenPGP digital signature