carbon2-commit: Handle non-list sequences better, delete-duplicates compiler macro.

[Michael Sperber]

changeset:   4751:5bb0735f56e0
user:        Aidan Kehoe <kehoea at parhasard.net>
date:        Sat Oct 03 14:22:08 2009 +0100
files:       lisp/ChangeLog lisp/cl-macs.el
description:
Handle non-list sequences better, delete-duplicates compiler macro.

2009-10-03  Aidan Kehoe  <kehoea at 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.


diff -r 7e79c8559ad1 -r 5bb0735f56e0 lisp/ChangeLog
--- 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 at 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 at xemacs.org>
 
 	* lisp.el (beginning-of-defun-raw): Unbreak; clean up sloppy
diff -r 7e79c8559ad1 -r 5bb0735f56e0 lisp/cl-macs.el
--- 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)