Mercurial > hg > xemacs-beta

diff lisp/cl-macs.el @ 5338:8608eadee6ba

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move #'delq, #'delete to Lisp, adding support for sequences. src/ChangeLog addition: 2011-01-11 Aidan Kehoe <kehoea@parhasard.net> * device-msw.c (Fmswindows_printer_list): Remove a Fdelete () call here, remove the necessity for it. * fns.c (Fdelete, Fdelq): * lisp.h: Move #'delete, #'delq to Lisp, implemented in terms of #'delete* * select.c (Fown_selection_internal): * select.c (handle_selection_clear): Use delq_no_quit() in these functions, don't reimplement it or use Fdelq(), which is now gone. lisp/ChangeLog addition: 2011-01-11 Aidan Kehoe <kehoea@parhasard.net> * subr.el (delete, delq, remove, remq): Move #'remove, #'remq here, they don't belong in cl-seq.el; move #'delete, #'delq here from fns.c, implement them in terms of #'delete*, allowing support for sequences generally. * update-elc.el (do-autoload-commands): Use #'delete*, not #'delq here, now the latter's no longer dumped. * cl-macs.el (delete, delq): Add compiler macros transforming #'delete and #'delq to #'delete* calls.
author Aidan Kehoe <kehoea@parhasard.net>
date Fri, 14 Jan 2011 23:35:29 +0000
parents 7b391d07b334
children ba62563ec7c7
line wrap: on
line diff
--- a/lisp/cl-macs.el	Fri Jan 14 23:23:30 2011 +0000
+++ b/lisp/cl-macs.el	Fri Jan 14 23:35:29 2011 +0000
@@ -3342,12 +3342,44 @@
       (list 'if (list* 'member* a list keys) list (list 'cons a list))
     form))
 
-(define-compiler-macro remove (item sequence)
-  `(remove* ,item ,sequence :test #'equal))
-
-(define-compiler-macro remq (item sequence)
-  `(remove* ,item ,sequence :test #'eq))
-
+(define-compiler-macro delete (&whole form &rest args)
+  (symbol-macrolet
+      ((not-constant '#:not-constant))
+    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+	       (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
+		   (characterp cl-const-expr-val)))
+	  (cons 'delete* (cdr form))
+	`(delete* ,@(cdr form) :test #'equal)))))
+
+(define-compiler-macro delq (&whole form &rest args)
+  (symbol-macrolet
+      ((not-constant '#:not-constant))
+    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+	       (not (cl-non-fixnum-number-p cl-const-expr-val)))
+	  (cons 'delete* (cdr form))
+	`(delete* ,@(cdr form) :test #'eq)))))
+
+(define-compiler-macro remove (&whole form &rest args)
+  (symbol-macrolet
+      ((not-constant '#:not-constant))
+    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+	       (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
+		   (characterp cl-const-expr-val)))
+	  (cons 'remove* (cdr form))
+	`(remove* ,@(cdr form) :test #'equal)))))
+
+(define-compiler-macro remq (&whole form &rest args)
+  (symbol-macrolet
+      ((not-constant '#:not-constant))
+    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+	       (not (cl-non-fixnum-number-p cl-const-expr-val)))
+	  (cons 'remove* (cdr form))
+	`(remove* ,@(cdr form) :test #'eq)))))
+ 
 (macrolet
     ((define-foo-if-compiler-macros (&rest alist)
        "Avoid the funcall, variable binding and keyword parsing overhead