changeset 5339:ba62563ec7c7

Accept more complex TYPEs in #'concatenate, cl-extra.el lisp/ChangeLog addition: 2011-01-15 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (concatenate): Accept more complicated TYPEs in this function, handing the sequences over to #'coerce if we don't understand them here. * cl-macs.el (inline): Don't proclaim #'concatenate as inline, its compiler macro is more useful than doing that. tests/ChangeLog addition: 2011-01-15 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el (list): Test #'concatenate, especially with more complicated TYPEs, which were previously not accepted by the function.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 15 Jan 2011 15:45:46 +0000
parents 8608eadee6ba
children 9dd4559b9e9a
files lisp/ChangeLog lisp/cl-extra.el lisp/cl-macs.el tests/ChangeLog tests/automated/lisp-tests.el
diffstat 5 files changed, 34 insertions(+), 7 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri Jan 14 23:35:29 2011 +0000
+++ b/lisp/ChangeLog	Sat Jan 15 15:45:46 2011 +0000
@@ -1,3 +1,11 @@
+2011-01-15  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-extra.el (concatenate): Accept more complicated TYPEs in this
+	function, handing the sequences over to #'coerce if we don't
+	understand them here.
+	* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
+	compiler macro is more useful than doing that.
+
 2011-01-11  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
--- a/lisp/cl-extra.el	Fri Jan 14 23:35:29 2011 +0000
+++ b/lisp/cl-extra.el	Sat Jan 15 15:45:46 2011 +0000
@@ -421,9 +421,9 @@
   (case type
     (vector (apply 'vconcat seqs))
     (string (apply 'concat seqs))
-    (list   (apply 'append (append seqs '(nil))))
+    (list   (reduce 'append seqs :from-end t :initial-value nil))
     (bit-vector (apply 'bvconcat seqs))
-    (t (error 'invalid-argument "Not a sequence type name" type))))
+    (t (coerce (reduce 'append seqs :from-end t :initial-value nil) type))))
 
 ;;; List functions.
 
--- a/lisp/cl-macs.el	Fri Jan 14 23:35:29 2011 +0000
+++ b/lisp/cl-macs.el	Sat Jan 15 15:45:46 2011 +0000
@@ -3831,10 +3831,9 @@
    (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar)
    (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr)))
 
-;;; Things that are inline.
-(proclaim '(inline acons map concatenate
-;; XEmacs omission: gethash is builtin
-		   cl-set-elt revappend nreconc))
+;;; Things that are inline. XEmacs; the functions that used to be here have
+;;; compiler macros or are built-in.
+(proclaim '(inline cl-set-elt))
 
 ;;; Things that are side-effect-free.  Moved to byte-optimize.el
 ;(mapcar (function (lambda (x) (put x 'side-effect-free t)))
--- a/tests/ChangeLog	Fri Jan 14 23:35:29 2011 +0000
+++ b/tests/ChangeLog	Sat Jan 15 15:45:46 2011 +0000
@@ -1,3 +1,9 @@
+2011-01-15  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el (list): Test #'concatenate, especially
+	with more complicated TYPEs, which were previously not accepted by
+	the function.
+
 2011-01-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el (list): Test #'find, especially the
--- a/tests/automated/lisp-tests.el	Fri Jan 14 23:35:29 2011 +0000
+++ b/tests/automated/lisp-tests.el	Sat Jan 15 15:45:46 2011 +0000
@@ -2814,6 +2814,20 @@
   (Assert (eq gensym (find 'not-in-it string :default gensym)))
   (Assert (eq 'hi-there (find 'hi-there list)))
   ;; Different uninterned symbols with the same name.
-  (Assert (not (eq '#1=#:everyone (find '#1# list)))))
+  (Assert (not (eq '#1=#:everyone (find '#1# list))))
+
+  ;; Test concatenate.
+  (Assert (equal list (concatenate 'list vector)))
+  (Assert (equal list (concatenate 'list (subseq vector 0 4)
+				   (subseq list 4))))
+  (Assert (equal vector (concatenate 'vector list)))
+  (Assert (equal vector (concatenate `(vector * ,(length vector)) list)))
+  (Assert (equal string (concatenate `(vector character ,(length string))
+				     (append string nil))))
+  (Assert (equal bit-vector (concatenate 'bit-vector (subseq bit-vector 0 4)
+					 (append (subseq bit-vector 4) nil))))
+  (Assert (equal bit-vector (concatenate `(vector bit ,(length bit-vector))
+					 (subseq bit-vector 0 4)
+					 (append (subseq bit-vector 4) nil)))))
 
 ;;; end of lisp-tests.el