Mercurial > hg > xemacs-beta
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)) |