carbon2-commit: Bit vectors are also sequences; enforce this in some CL functions.

changeset: 5298:f3eca926258e user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Sat Jul 24 17:38:35 2010 +0100 files: lisp/ChangeLog lisp/cl-extra.el lisp/cl-macs.el lisp/cl-seq.el description: Bit vectors are also sequences; enforce this in some CL functions. lisp/ChangeLog addition: 2010-07-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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. diff -r d579d76f3dcc -r f3eca926258e lisp/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)xemacs.org&gt; * gnome.el: diff -r d579d76f3dcc -r f3eca926258e lisp/cl-extra.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. diff -r d579d76f3dcc -r f3eca926258e lisp/cl-macs.el --- 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) diff -r d579d76f3dcc -r f3eca926258e lisp/cl-seq.el --- 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. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches