Mercurial > hg > xemacs-beta
comparison lisp/byte-optimize.el @ 5292:e4305eb6fb8c
Merge some permissions corrections to trunk.
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Mon, 18 Oct 2010 23:21:23 +0900 |
| parents | 99de5fd48e87 |
| children | bbff29a01820 |
comparison
equal
deleted
inserted
replaced
| 5291:85bd42a1e544 | 5292:e4305eb6fb8c |
|---|---|
| 1117 (defun byte-optimize-apply (form) | 1117 (defun byte-optimize-apply (form) |
| 1118 ;; If the last arg is a literal constant, turn this into a funcall. | 1118 ;; If the last arg is a literal constant, turn this into a funcall. |
| 1119 ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...). | 1119 ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...). |
| 1120 (let ((fn (nth 1 form)) | 1120 (let ((fn (nth 1 form)) |
| 1121 (last (nth (1- (length form)) form))) ; I think this really is fastest | 1121 (last (nth (1- (length form)) form))) ; I think this really is fastest |
| 1122 (or (if (or (null last) | 1122 (if (and (eq last (third form)) |
| 1123 (eq (car-safe last) 'quote)) | 1123 (consp last) |
| 1124 (if (listp (nth 1 last)) | 1124 (eq 'mapcar (car last)) |
| 1125 (let ((butlast (nreverse (cdr (reverse (cdr (cdr form))))))) | 1125 (equal fn ''nconc)) |
| 1126 (nconc (list 'funcall fn) butlast | 1126 (progn |
| 1127 (mapcar #'(lambda (x) (list 'quote x)) (nth 1 last)))) | 1127 (byte-compile-warn |
| 1128 (byte-compile-warn | 1128 "(apply 'nconc (mapcar ..)), use #'mapcan instead: %s" last) |
| 1129 "last arg to apply can't be a literal atom: %s" | 1129 (cons 'mapcan (cdr last))) |
| 1130 (prin1-to-string last)) | 1130 (or (if (or (null last) |
| 1131 nil)) | 1131 (eq (car-safe last) 'quote)) |
| 1132 form))) | 1132 (if (listp (nth 1 last)) |
| 1133 (let ((butlast (nreverse (cdr (reverse (cdr (cdr form))))))) | |
| 1134 (nconc (list 'funcall fn) butlast | |
| 1135 (mapcar #'(lambda (x) (list 'quote x)) | |
| 1136 (nth 1 last)))) | |
| 1137 (byte-compile-warn | |
| 1138 "last arg to apply can't be a literal atom: %s" | |
| 1139 (prin1-to-string last)) | |
| 1140 nil)) | |
| 1141 form)))) | |
| 1133 | 1142 |
| 1134 (put 'funcall 'byte-optimizer 'byte-optimize-funcall) | 1143 (put 'funcall 'byte-optimizer 'byte-optimize-funcall) |
| 1135 (put 'apply 'byte-optimizer 'byte-optimize-apply) | 1144 (put 'apply 'byte-optimizer 'byte-optimize-apply) |
| 1136 | 1145 |
| 1137 | 1146 |
| 1214 buffer-modified-p buffer-substring | 1223 buffer-modified-p buffer-substring |
| 1215 capitalize car-less-than-car car cdr ceiling concat | 1224 capitalize car-less-than-car car cdr ceiling concat |
| 1216 ;; coordinates-in-window-p not in XEmacs | 1225 ;; coordinates-in-window-p not in XEmacs |
| 1217 copy-marker cos count-lines | 1226 copy-marker cos count-lines |
| 1218 default-boundp default-value denominator documentation downcase | 1227 default-boundp default-value denominator documentation downcase |
| 1219 elt exp expt fboundp featurep | 1228 elt endp exp expt fboundp featurep |
| 1220 file-directory-p file-exists-p file-locked-p file-name-absolute-p | 1229 file-directory-p file-exists-p file-locked-p file-name-absolute-p |
| 1221 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p | 1230 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p |
| 1222 float floor format | 1231 float floor format |
| 1223 get get-buffer get-buffer-window getenv get-file-buffer | 1232 get get-buffer get-buffer-window getenv get-file-buffer |
| 1224 ;; hash-table functions | 1233 ;; hash-table functions |