diff lisp/cl-macs.el @ 5468:a9094f28f9a9

Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Wed, 19 Jan 2011 22:35:23 +0100
parents 89331fa1c819 ba62563ec7c7
children 0af042a0c116
line wrap: on
line diff
--- a/lisp/cl-macs.el	Fri Jan 14 23:32:08 2011 +0100
+++ b/lisp/cl-macs.el	Wed Jan 19 22:35:23 2011 +0100
@@ -3340,12 +3340,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
@@ -3797,10 +3829,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)))