changeset 4707:5bb0735f56e0

Handle non-list sequences better, delete-duplicates compiler macro. 2009-10-03 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete-duplicates): Make this compiler macro aware that CL-SEQ is a sequence, which may not necessarily be a list.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 03 Oct 2009 14:22:08 +0100
parents 7e79c8559ad1
children 1cecc3e9f0a0
files lisp/ChangeLog lisp/cl-macs.el
diffstat 2 files changed, 46 insertions(+), 20 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Thu Oct 01 18:00:11 2009 +0200
+++ b/lisp/ChangeLog	Sat Oct 03 14:22:08 2009 +0100
@@ -1,3 +1,9 @@
+2009-10-03  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (delete-duplicates): 
+	Make this compiler macro aware that CL-SEQ is a sequence, which
+	may not necessarily be a list.
+
 2009-09-30  Mike Sperber  <mike@xemacs.org>
 
 	* lisp.el (beginning-of-defun-raw): Unbreak; clean up sloppy
--- a/lisp/cl-macs.el	Thu Oct 01 18:00:11 2009 +0200
+++ b/lisp/cl-macs.el	Sat Oct 03 14:22:08 2009 +0100
@@ -3218,26 +3218,46 @@
 ;; #'equal or #'eq and no other keywords, we want the speed in
 ;; font-lock.el.
 (define-compiler-macro delete-duplicates (&whole form cl-seq &rest cl-keys)
-  (cond ((and (= 4 (length form))
-              (eq :test (third form))
-              (or (equal '(quote eq) (fourth form))
-                  (equal '(function eq) (fourth form))))
-         `(let* ((begin ,cl-seq)
-                 (cl-seq begin))
-           (while cl-seq
-             (setq cl-seq (setcdr cl-seq (delq (car cl-seq) (cdr cl-seq)))))
-           begin))
-        ((and (= 4 (length form))
-              (eq :test (third form))
-              (or (equal '(quote equal) (fourth form))
-                  (equal '(function equal) (fourth form))))
-         `(let* ((begin ,cl-seq)
-                 (cl-seq begin))
-           (while cl-seq
-             (setq cl-seq (setcdr cl-seq (delete (car cl-seq) (cdr cl-seq)))))
-           begin))
-        (t
-         form)))
+  (let ((listp-check 
+         (if (memq (car-safe cl-seq)
+                   ;; No need to check for a list at runtime with these. We
+                   ;; could expand the list, but these are all the functions
+                   ;; in the relevant context at the moment.
+                   '(nreverse append nconc mapcan mapcar))
+             t
+           '(listp begin))))
+    (cond ((and (= 4 (length form))
+                (eq :test (third form))
+                (or (equal '(quote eq) (fourth form))
+                    (equal '(function eq) (fourth form))))
+           `(let* ((begin ,cl-seq)
+                   (cl-seq begin))
+             (if ,listp-check
+                 (progn
+                   (while cl-seq
+                     (setq cl-seq (setcdr cl-seq (delq (car cl-seq)
+                                                       (cdr cl-seq)))))
+                   begin)
+               ;; Call cl-delete-duplicates explicitly, to avoid the form
+               ;; getting compiler-macroexpanded again:
+               (cl-delete-duplicates begin ,(third form) ,(fourth form) nil))))
+          ((and (= 4 (length form))
+                (eq :test (third form))
+                (or (equal '(quote equal) (fourth form))
+                    (equal '(function equal) (fourth form))))
+           `(let* ((begin ,cl-seq)
+                   (cl-seq begin))
+             (if ,listp-check
+                 (progn
+                   (while cl-seq
+                     (setq cl-seq (setcdr cl-seq (delete (car cl-seq)
+                                                         (cdr cl-seq)))))
+                   begin)
+               ;; Call cl-delete-duplicates explicitly, to avoid the form
+               ;; getting compiler-macroexpanded again:
+               (cl-delete-duplicates begin ,(third form) ,(fourth form) nil))))
+          (t
+           form))))
 
 (mapc
  #'(lambda (y)