changeset 5242:f3eca926258e

Bit vectors are also sequences; enforce this in some CL functions. lisp/ChangeLog addition: 2010-07-24 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (concatenate): * cl-seq.el (remove*, cl-delete-duplicates): Bit vectors are also sequences; enforce this in these functions. * cl-macs.el (concatenate): If TYPE is constant, don't inline #'concatenate, replace it by a call to the appropriate C functions.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 24 Jul 2010 17:38:35 +0100
parents d579d76f3dcc
children 808131ba4a57
files lisp/ChangeLog lisp/cl-extra.el lisp/cl-macs.el lisp/cl-seq.el
diffstat 4 files changed, 29 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Jul 24 15:56:57 2010 +0100
+++ b/lisp/ChangeLog	Sat Jul 24 17:38:35 2010 +0100
@@ -1,3 +1,12 @@
+2010-07-24  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-extra.el (concatenate):
+	* cl-seq.el (remove*, cl-delete-duplicates):
+	Bit vectors are also sequences; enforce this in these functions.
+	* cl-macs.el (concatenate):
+	If TYPE is constant, don't inline #'concatenate, replace it by a
+	call to the appropriate C functions.
+
 2010-06-13  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* gnome.el:
--- a/lisp/cl-extra.el	Sat Jul 24 15:56:57 2010 +0100
+++ b/lisp/cl-extra.el	Sat Jul 24 17:38:35 2010 +0100
@@ -392,6 +392,7 @@
     (vector (apply 'vconcat seqs))
     (string (apply 'concat seqs))
     (list   (apply 'append (append seqs '(nil))))
+    (bit-vector (apply 'bvconcat seqs))
     (t (error 'invalid-argument "Not a sequence type name" type))))
 
 ;;; List functions.
--- a/lisp/cl-macs.el	Sat Jul 24 15:56:57 2010 +0100
+++ b/lisp/cl-macs.el	Sat Jul 24 17:38:35 2010 +0100
@@ -3751,6 +3751,16 @@
                                     :test #'equal))
         ,stack-depth))))
 
+(define-compiler-macro concatenate (&whole form type &rest seqs)
+  (if (and (cl-const-expr-p type) (memq (cl-const-expr-val type)
+                                        '(vector bit-vector list string)))
+      (case (cl-const-expr-val type)
+        (list (append (list 'append) (cddr form) '(nil)))
+        (vector (cons 'vconcat (cddr form)))
+        (bit-vector (cons 'bvconcat (cddr form)))
+        (string (cons 'concat (cddr form))))
+    form))
+
 (mapc
  #'(lambda (y)
      (put (car y) 'side-effect-free t)
--- a/lisp/cl-seq.el	Sat Jul 24 15:56:57 2010 +0100
+++ b/lisp/cl-seq.el	Sat Jul 24 17:38:35 2010 +0100
@@ -215,8 +215,11 @@
 						 (list :end (1+ cl-i))
 					       (list :start cl-i))
 					     cl-keys))))
-		  (if (listp cl-seq) cl-res
-		    (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
+                  (typecase cl-seq
+                    (list cl-res)
+                    (string (concat cl-res))
+                    (vector (vconcat cl-res))
+                    (bit-vector (bvconcat cl-res))))
 	      cl-seq))
 	(setq cl-end (- (or cl-end 8000000) cl-start))
 	(if (= cl-start 0)
@@ -382,7 +385,10 @@
 	      (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
 	    cl-seq)))
     (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil)))
-      (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
+      (typecase cl-seq
+        (string (concat cl-res))
+        (vector (vconcat cl-res))
+        (bit-vector (bvconcat cl-res))))))
 
 (defun substitute (cl-new cl-old cl-seq &rest cl-keys)
   "Substitute NEW for OLD in SEQ.