Mercurial > hg > xemacs-beta
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.