comparison lisp/cl-macs.el @ 5366:f00192e1cd49

Examining the result of #'length: `eql', not `=', it's better style & cheaper 2011-03-08 Aidan Kehoe <kehoea@parhasard.net> * buff-menu.el (list-buffers-noselect): * byte-optimize.el (byte-optimize-identity): * byte-optimize.el (byte-optimize-if): * byte-optimize.el (byte-optimize-nth): * byte-optimize.el (byte-optimize-nthcdr): * bytecomp.el (byte-compile-warn-wrong-args): * bytecomp.el (byte-compile-two-args-19->20): * bytecomp.el (byte-compile-list): * bytecomp.el (byte-compile-beginning-of-line): * bytecomp.el (byte-compile-set): * bytecomp.el (byte-compile-set-default): * bytecomp.el (byte-compile-values): * bytecomp.el (byte-compile-values-list): * bytecomp.el (byte-compile-integerp): * bytecomp.el (byte-compile-multiple-value-list-internal): * bytecomp.el (byte-compile-throw): * cl-macs.el (cl-do-arglist): * cl-macs.el (cl-parse-loop-clause): * cl-macs.el (multiple-value-bind): * cl-macs.el (multiple-value-setq): * cl-macs.el (get-setf-method): * cmdloop.el (command-error): * cmdloop.el (y-or-n-p-minibuf): * cmdloop.el (yes-or-no-p-minibuf): * coding.el (unencodable-char-position): * cus-edit.el (custom-face-prompt): * cus-edit.el (custom-buffer-create-internal): * cus-edit.el (widget-face-action): * cus-edit.el (custom-group-value-create): * descr-text.el (describe-char-unicode-data): * dialog-gtk.el (popup-builtin-question-dialog): * dragdrop.el (experimental-dragdrop-drop-log-function): * dragdrop.el (experimental-dragdrop-drop-mime-default): * easymenu.el (easy-menu-add): * easymenu.el (easy-menu-remove): * faces.el (read-face-name): * faces.el (set-face-stipple): * files.el (file-name-non-special): * font.el (font-combine-fonts): * font.el (font-set-face-font): * font.el (font-parse-rgb-components): * font.el (font-rgb-color-p): * font.el (font-color-rgb-components): * gnuserv.el (gnuserv-edit-files): * help.el (key-or-menu-binding): * help.el (function-documentation-1): * help.el (function-documentation): * info.el (info): * isearch-mode.el (isearch-exit): * isearch-mode.el (isearch-edit-string): * isearch-mode.el (isearch-*-char): * isearch-mode.el (isearch-complete1): * ldap.el (ldap-encode-country-string): * ldap.el (ldap-decode-string): * minibuf.el (read-file-name-internal-1): * minibuf.el (read-non-nil-coding-system): * minibuf.el (get-user-response): * mouse.el (drag-window-divider): * mule/ccl.el: * mule/ccl.el (ccl-compile-if): * mule/ccl.el (ccl-compile-break): * mule/ccl.el (ccl-compile-repeat): * mule/ccl.el (ccl-compile-write-repeat): * mule/ccl.el (ccl-compile-call): * mule/ccl.el (ccl-compile-end): * mule/ccl.el (ccl-compile-read-multibyte-character): * mule/ccl.el (ccl-compile-write-multibyte-character): * mule/ccl.el (ccl-compile-translate-character): * mule/ccl.el (ccl-compile-mule-to-unicode): * mule/ccl.el (ccl-compile-unicode-to-mule): * mule/ccl.el (ccl-compile-lookup-integer): * mule/ccl.el (ccl-compile-lookup-character): * mule/ccl.el (ccl-compile-map-multiple): * mule/ccl.el (ccl-compile-map-single): * mule/devan-util.el (devanagari-compose-to-one-glyph): * mule/devan-util.el (devanagari-composition-component): * mule/mule-cmds.el (finish-set-language-environment): * mule/viet-util.el: * mule/viet-util.el (viet-encode-viscii-char): * multicast.el (open-multicast-group): * newcomment.el (comment-quote-nested): * newcomment.el (comment-region): * newcomment.el (comment-dwim): * regexp-opt.el (regexp-opt-group): * replace.el (map-query-replace-regexp): * specifier.el (derive-device-type-from-tag-set): * subr.el (skip-chars-quote): * test-harness.el (test-harness-from-buffer): * test-harness.el (batch-test-emacs): * wid-edit.el (widget-choice-action): * wid-edit.el (widget-symbol-prompt-internal): * wid-edit.el (widget-color-action): * window-xemacs.el (push-window-configuration): * window-xemacs.el (pop-window-configuration): * window.el (quit-window): * x-compose.el (electric-diacritic): It's better style, and cheaper (often one assembler instruction vs. a C funcall in the byte code), to use `eql' instead of `=' when it's clear what numerical type a given result will be. Change much of our code to do this, with the help of a byte-compiler change (not comitted) that looked for calls to #'length (which always returns an integer) in its args.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 08 Mar 2011 23:41:52 +0000
parents 5dd1ba5e0113
children 8b70d37ab80e
comparison
equal deleted inserted replaced
5365:dbae25a8949d 5366:f00192e1cd49
426 (setq minarg restarg) 426 (setq minarg restarg)
427 (while (and p (not (memq (car p) lambda-list-keywords))) 427 (while (and p (not (memq (car p) lambda-list-keywords)))
428 (or (eq p args) (setq minarg (list 'cdr minarg))) 428 (or (eq p args) (setq minarg (list 'cdr minarg)))
429 (setq p (cdr p))) 429 (setq p (cdr p)))
430 (if (memq (car p) '(nil &aux)) 430 (if (memq (car p) '(nil &aux))
431 (setq minarg (list '= (list 'length restarg) 431 (setq minarg (list 'eql (list 'length restarg)
432 (length (ldiff args p))) 432 (length (ldiff args p)))
433 exactarg (not (eq args p))))) 433 exactarg (not (eq args p)))))
434 (while (and args (not (memq (car args) lambda-list-keywords))) 434 (while (and args (not (memq (car args) lambda-list-keywords)))
435 (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car) 435 (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
436 restarg))) 436 restarg)))
1263 (and (not (memq (car args) '(in of))) 1263 (and (not (memq (car args) '(in of)))
1264 (error "Expected `of'")))) 1264 (error "Expected `of'"))))
1265 (seq (cl-pop2 args)) 1265 (seq (cl-pop2 args))
1266 (temp-seq (gensym)) 1266 (temp-seq (gensym))
1267 (temp-idx (if (eq (car args) 'using) 1267 (temp-idx (if (eq (car args) 'using)
1268 (if (and (= (length (cadr args)) 2) 1268 (if (and (eql (length (cadr args)) 2)
1269 (eq (caadr args) 'index)) 1269 (eq (caadr args) 'index))
1270 (cadr (cl-pop2 args)) 1270 (cadr (cl-pop2 args))
1271 (error "Bad `using' clause")) 1271 (error "Bad `using' clause"))
1272 (gensym)))) 1272 (gensym))))
1273 (push (list temp-seq seq) loop-for-bindings) 1273 (push (list temp-seq seq) loop-for-bindings)
1294 1294
1295 ((memq word hash-types) 1295 ((memq word hash-types)
1296 (or (memq (car args) '(in of)) (error "Expected `of'")) 1296 (or (memq (car args) '(in of)) (error "Expected `of'"))
1297 (let* ((table (cl-pop2 args)) 1297 (let* ((table (cl-pop2 args))
1298 (other (if (eq (car args) 'using) 1298 (other (if (eq (car args) 'using)
1299 (if (and (= (length (cadr args)) 2) 1299 (if (and (eql (length (cadr args)) 2)
1300 (memq (caadr args) hash-types) 1300 (memq (caadr args) hash-types)
1301 (not (eq (caadr args) word))) 1301 (not (eq (caadr args) word)))
1302 (cadr (cl-pop2 args)) 1302 (cadr (cl-pop2 args))
1303 (error "Bad `using' clause")) 1303 (error "Bad `using' clause"))
1304 (gensym)))) 1304 (gensym))))
1350 ((memq word key-types) 1350 ((memq word key-types)
1351 (or (memq (car args) '(in of)) (error "Expected `of'")) 1351 (or (memq (car args) '(in of)) (error "Expected `of'"))
1352 (let* ((map (cl-pop2 args)) 1352 (let* ((map (cl-pop2 args))
1353 other-word 1353 other-word
1354 (other (if (eq (car args) 'using) 1354 (other (if (eq (car args) 'using)
1355 (if (and (= (length (cadr args)) 2) 1355 (if (and (eql (length (cadr args)) 2)
1356 (memq (setq other-word (caadr args)) 1356 (memq (setq other-word (caadr args))
1357 key-types) 1357 key-types)
1358 (not (eq (caadr args) word))) 1358 (not (eq (caadr args) word)))
1359 (cadr (cl-pop2 args)) 1359 (cadr (cl-pop2 args))
1360 (error "Bad `using' clause")) 1360 (error "Bad `using' clause"))
1878 not return multiple values, it is treated as returning one multiple value. 1878 not return multiple values, it is treated as returning one multiple value.
1879 1879
1880 Returns the value given by the last element of BODY." 1880 Returns the value given by the last element of BODY."
1881 (if (null syms) 1881 (if (null syms)
1882 `(progn ,form ,@body) 1882 `(progn ,form ,@body)
1883 (if (= 1 (length syms)) 1883 (if (eql 1 (length syms))
1884 ;; Code written to deal with other "implementations" of multiple 1884 ;; Code written to deal with other "implementations" of multiple
1885 ;; values may have a one-element SYMS. 1885 ;; values may have a one-element SYMS.
1886 `(let ((,(car syms) ,form)) 1886 `(let ((,(car syms) ,form))
1887 ,@body) 1887 ,@body)
1888 (let ((temp (gensym))) 1888 (let ((temp (gensym)))
1905 1905
1906 Returns the first of the multiple values given by FORM." 1906 Returns the first of the multiple values given by FORM."
1907 (if (null syms) 1907 (if (null syms)
1908 ;; Never return multiple values from multiple-value-setq: 1908 ;; Never return multiple values from multiple-value-setq:
1909 (and form `(values ,form)) 1909 (and form `(values ,form))
1910 (if (= 1 (length syms)) 1910 (if (eql 1 (length syms))
1911 `(setq ,(car syms) ,form) 1911 `(setq ,(car syms) ,form)
1912 (let ((temp (gensym))) 1912 (let ((temp (gensym)))
1913 `(let* ((,temp (multiple-value-list-internal 0 ,(length syms) ,form))) 1913 `(let* ((,temp (multiple-value-list-internal 0 ,(length syms) ,form)))
1914 (setq ,@(loop 1914 (setq ,@(loop
1915 for sym in syms 1915 for sym in syms
2432 (method (get func 'setf-method)) 2432 (method (get func 'setf-method))
2433 (case-fold-search nil)) 2433 (case-fold-search nil))
2434 (or (and method 2434 (or (and method
2435 (let ((cl-macro-environment env)) 2435 (let ((cl-macro-environment env))
2436 (setq method (apply method (cdr place)))) 2436 (setq method (apply method (cdr place))))
2437 (if (and (consp method) (= (length method) 5)) 2437 (if (and (consp method) (eql (length method) 5))
2438 method 2438 method
2439 (error "Setf-method for %s returns malformed method" 2439 (error "Setf-method for %s returns malformed method"
2440 func))) 2440 func)))
2441 (and (save-match-data 2441 (and (save-match-data
2442 (string-match "\\`c[ad][ad][ad]?[ad]?r\\'" name)) 2442 (string-match "\\`c[ad][ad][ad]?[ad]?r\\'" name))