Mercurial > hg > xemacs-beta

diff lisp/cl-macs.el @ 5652:cc6f0266bc36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary lisp/ChangeLog addition: 2012-05-01 Aidan Kehoe <kehoea@parhasard.net> Avoid #'delq in core code, for the sake of style and a (very slightly) smaller binary. * behavior.el (disable-behavior): * behavior.el (compute-behavior-group-children): * buff-menu.el (buffers-tab-items): * byte-optimize.el (byte-optimize-delay-constants-math): * byte-optimize.el (byte-optimize-logmumble): * byte-optimize.el (byte-decompile-bytecode-1): * byte-optimize.el (byte-optimize-lapcode): * bytecomp.el: * bytecomp.el (byte-compile-arglist-warn): * bytecomp.el (byte-compile-warn-about-unresolved-functions): * bytecomp.el (byte-compile-lambda): * bytecomp.el (byte-compile-out-toplevel): * bytecomp.el (byte-compile-insert): * bytecomp.el (byte-compile-defalias-warn): * cl-macs.el (cl-upcase-arg): * cl-macs.el (cl-transform-lambda): * cl-macs.el (cl-do-proclaim): * cl-macs.el (defstruct): * cl-macs.el (cl-make-type-test): * cl-macs.el (define-compiler-macro): * cl-macs.el (delete-duplicates): * cus-edit.el (widget-face-value-delete): * cus-edit.el (face-history): * easymenu.el (easy-menu-remove): * files.el (files-fetch-hook-value): * files.el (file-expand-wildcards): * font-lock.el (font-lock-update-removed-keyword-alist): * font-lock.el (font-lock-remove-keywords): * frame.el (frame-initialize): * frame.el (frame-notice-user-settings): * frame.el (set-frame-font): * frame.el (delete-other-frames): * frame.el (get-frame-for-buffer-noselect): * gnuserv.el (gnuserv-kill-buffer-function): * gnuserv.el (gnuserv-check-device): * gnuserv.el (gnuserv-kill-client): * gnuserv.el (gnuserv-buffer-done-1): * gtk-font-menu.el (gtk-reset-device-font-menus): * gutter-items.el (buffers-tab-items): * gutter.el (set-gutter-element-visible-p): * info.el (Info-find-file-node): * info.el (Info-history-add): * info.el (Info-build-annotation-completions): * info.el (Info-index): * info.el (Info-reannotate-node): * itimer.el (delete-itimer): * itimer.el (start-itimer): * lib-complete.el (lib-complete:cache-completions): * loadhist.el (unload-feature): * menubar-items.el (build-buffers-menu-internal): * menubar.el (delete-menu-item): * menubar.el (relabel-menu-item): * msw-font-menu.el (mswindows-reset-device-font-menus): * mule/make-coding-system.el (fixed-width-generate-helper): * next-error.el (next-error-find-buffer): * obsolete.el: * obsolete.el (find-non-ascii-charset-string): * obsolete.el (find-non-ascii-charset-region): * occur.el (multi-occur-by-filename-regexp): * occur.el (occur-1): * packages.el (packages-package-hierarchy-directory-names): * packages.el (package-get-key-1): * process.el (setenv): * simple.el (undo): * simple.el (handle-pre-motion-command-current-command-is-motion): * sound.el (load-sound-file): * wid-edit.el (widget-field-value-delete): * wid-edit.el (widget-checklist-match-inline): * wid-edit.el (widget-checklist-match-find): * wid-edit.el (widget-editable-list-delete-at): * wid-edit.el (widget-editable-list-entry-create): * window.el (quit-window): * x-font-menu.el (x-reset-device-font-menus-core): 1. Replace (delq nil (mapcar ....)) with analogous (mapcan ...) forms; this is in non-dumped files, it was done previously in dumped files. 2. Replace (delq FOO (copy-sequence BAR)) with (remove* FOO BAR), where #'eq and #'eql are equivalent 3. Replace (delq FOO BAR) with (delete* FOO BAR), where FOO is not a non-fixnum number. Saves a little space in the dumped file (since the compiler macro adds :test #'eq to the delete* call if it's not clear that FOO is not a non-fixnum number).
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 01 May 2012 16:17:42 +0100
parents ae2fdb1fd9e0
children e9c3fe82127d
line wrap: on
line diff
--- a/lisp/cl-macs.el	Tue May 01 12:43:22 2012 +0100
+++ b/lisp/cl-macs.el	Tue May 01 16:17:42 2012 +0100
@@ -299,9 +299,9 @@
 	   ;; Clean the list
 	   (let ((p (last arg))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
 	   (if (setq junk (cadr (memq '&cl-defs arg)))
-	       (setq arg (delq '&cl-defs (delq junk arg))))
+	       (setq arg (delete* '&cl-defs (delete* junk arg))))
 	   (if (memq '&cl-quote arg)
-	       (setq arg (delq '&cl-quote arg)))
+	       (setq arg (delete* '&cl-quote arg)))
 	   (mapcar 'cl-upcase-arg arg)))
 	(t arg)))                         ; Maybe we are in initializer
 
@@ -346,13 +346,13 @@
     (setq args (if (listp args) (copy-list args) (list '&rest args)))
     (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
     (if (setq bind-defs (cadr (memq '&cl-defs args)))
-	(setq args (delq '&cl-defs (delq bind-defs args))
+	(setq args (delete* '&cl-defs (delete* bind-defs args))
 	      bind-defs (cadr bind-defs)))
     (if (setq bind-enquote (memq '&cl-quote args))
-	(setq args (delq '&cl-quote args)))
+	(setq args (delete* '&cl-quote args)))
     (if (memq '&whole args) (error "&whole not currently implemented"))
     (let* ((p (memq '&environment args)) (v (cadr p)))
-      (if p (setq args (nconc (delq (car p) (delq v args))
+      (if p (setq args (nconc (delete* (car p) (delete* v args))
                               `(&aux (,v byte-compile-macro-environment))))))
     (while (and args (symbolp (car args))
 		(not (memq (car args) '(nil &rest &body &key &aux)))
@@ -1916,7 +1916,7 @@
 	   (if (consp (car spec))
 	       (if (eq (cadar spec) 0)
 		   (setq byte-compile-warnings
-			 (delq (caar spec) byte-compile-warnings))
+			 (delete* (caar spec) byte-compile-warnings))
 		 (setq byte-compile-warnings
 		       (adjoin (caar spec) byte-compile-warnings)))))))
   nil)
@@ -2806,7 +2806,7 @@
 				     (caar include-descs) include))
 			  old-descs)
 		    (pop include-descs)))
-	  (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs))
+	  (setq descs (append old-descs (delete* (assq 'cl-tag-slot descs) descs))
 		type (car inc-type)
 		named (assq 'cl-tag-slot descs))
 	  (if (cadr inc-type) (setq tag name named t))
@@ -2822,7 +2822,7 @@
 		(error "Illegal :type specifier: %s" type))
 	    (if named (setq tag name)))
 	(setq type 'vector named 'true)))
-    (or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
+    (or named (setq descs (delete* (assq 'cl-tag-slot descs) descs)))
     (push (list 'defvar tag-symbol) forms)
     (setq pred-form (and named
 			 (let ((pos (- (length descs)
@@ -2896,8 +2896,8 @@
 		(push (cons copier t) side-eff)))
     (if constructor
 	(push (list constructor
-		       (cons '&key (delq nil (copy-sequence slots))))
-		 constrs))
+                    (cons '&key (remove* nil slots)))
+              constrs))
     (while constrs
       (let* ((name (caar constrs))
 	     (args (cadr (pop constrs)))
@@ -2988,7 +2988,7 @@
 	   (cl-make-type-test val (apply (get (car type) 'cl-deftype-handler)
 					 (cdr type))))
 	  ((memq (car-safe type) '(integer float real number))
-	   (delq t (list 'and (cl-make-type-test val (car type))
+	   (delete* t (list 'and (cl-make-type-test val (car type))
 			 (if (memq (cadr type) '(* nil)) t
 			   (if (consp (cadr type)) (list '> val (caadr type))
 			     (list '>= val (cadr type))))
@@ -3086,7 +3086,7 @@
   (list 'eval-when '(compile load eval)
 	(cl-transform-function-property
 	 func 'cl-compiler-macro
-	 (cons (if (memq '&whole args) (delq '&whole args)
+	 (cons (if (memq '&whole args) (delete* '&whole args)
 		 (cons '--cl-whole-arg-- args)) body))
 	(list 'or (list 'get (list 'quote func) '(quote byte-compile))
 	      (list 'put (list 'quote func) '(quote byte-compile)
@@ -3519,7 +3519,7 @@
 		(cl-seq begin))
 	  (while cl-seq
 	    (setq cl-seq (setcdr cl-seq
-				 (delq (car cl-seq) (cdr cl-seq)))))
+				 (delete* (car cl-seq) (cdr cl-seq)))))
 	  begin))
        ((or (plists-equal cl-keys '(:test 'equal) t)
 	    (plists-equal cl-keys '(:test #'equal) t))