Mercurial > hg > xemacs-beta
comparison lisp/cl-macs.el @ 5523:810b77562486
Improve #'defsubst* a little, document a bug that remains.
2011-06-19 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (defsubst*):
* cl-macs.el (cl-defsubst-expand):
If defaults refer to earlier args, or if there's a &rest arg, use
#'proclaim-inline.
Use #'symbol-macrolet instead of #'subst when replacing argument
names with their values in the inline expansion; this avoids
(most) instances where the symbol's function slot is used.
Document a bug that occurs if the symbol is being shadowed in a
lexically-contained scope.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 19 Jun 2011 19:03:39 +0100 |
| parents | 544e6336d37c |
| children | 2a6a8da4dd7c |
comparison
equal
deleted
inserted
replaced
| 5522:544e6336d37c | 5523:810b77562486 |
|---|---|
| 3199 (cons docstring body))) | 3199 (cons docstring body))) |
| 3200 (pbody (cons 'progn exec-body)) | 3200 (pbody (cons 'progn exec-body)) |
| 3201 (unsafe (not (cl-safe-expr-p pbody)))) | 3201 (unsafe (not (cl-safe-expr-p pbody)))) |
| 3202 (while (and p (eq (cl-expr-contains arglist (car p)) 1)) (pop p)) | 3202 (while (and p (eq (cl-expr-contains arglist (car p)) 1)) (pop p)) |
| 3203 (list 'progn | 3203 (list 'progn |
| 3204 (if p nil ; give up if defaults refer to earlier args | 3204 (if (or p (memq '&rest arglist)) |
| 3205 ; Defaults refer to earlier args, or we would have to cons up | |
| 3206 ; something for &rest: | |
| 3207 (list 'proclaim-inline name) | |
| 3205 (list 'define-compiler-macro name | 3208 (list 'define-compiler-macro name |
| 3206 (if (memq '&key arglist) | 3209 (if (memq '&key arglist) |
| 3207 (list* '&whole 'cl-whole '&cl-quote arglist) | 3210 (list* '&whole 'cl-whole '&cl-quote arglist) |
| 3208 (cons '&cl-quote arglist)) | 3211 (cons '&cl-quote arglist)) |
| 3209 (list* 'cl-defsubst-expand (list 'quote argns) | 3212 (list* 'cl-defsubst-expand (list 'quote argns) |
| 3211 (not (or unsafe (cl-expr-access-order pbody argns))) | 3214 (not (or unsafe (cl-expr-access-order pbody argns))) |
| 3212 (and (memq '&key arglist) 'cl-whole) unsafe argns))) | 3215 (and (memq '&key arglist) 'cl-whole) unsafe argns))) |
| 3213 (list* 'defun* name arglist docstring body)))) | 3216 (list* 'defun* name arglist docstring body)))) |
| 3214 | 3217 |
| 3215 (defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs) | 3218 (defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs) |
| 3216 (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole | 3219 (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) |
| 3217 (if (cl-simple-exprs-p argvs) (setq simple t)) | 3220 whole |
| 3218 (let ((lets (mapcan #'(lambda (argn argv) | 3221 (if (cl-simple-exprs-p argvs) |
| 3219 (if (or simple (cl-const-expr-p argv)) | 3222 (setq simple t)) |
| 3220 (progn (setq body (subst argv argn body)) | 3223 (let* ((symbol-macros nil) |
| 3221 (and unsafe (list (list argn argv)))) | 3224 (lets (mapcan #'(lambda (argn argv) |
| 3222 (list (list argn argv)))) | 3225 (if (or simple (cl-const-expr-p argv)) |
| 3223 argns argvs))) | 3226 (progn (push (list argn argv) symbol-macros) |
| 3224 (if lets (list 'let lets body) body)))) | 3227 (and unsafe (list (list argn argv)))) |
| 3228 (list (list argn argv)))) | |
| 3229 argns argvs))) | |
| 3230 `(let ,lets | |
| 3231 (symbol-macrolet | |
| 3232 ;; #### Bug; this will happily substitute in places where the | |
| 3233 ;; symbol is being shadowed in a different scope (e.g. inside | |
| 3234 ;; let bindings or lambda expressions where it has been | |
| 3235 ;; bound). We don't have GNU's issue where the replacement will | |
| 3236 ;; be done when the symbol is used in a function context, | |
| 3237 ;; because we're using #'symbol-macrolet instead of #'subst. | |
| 3238 ,symbol-macros | |
| 3239 ,body))))) | |
| 3225 | 3240 |
| 3226 ;; When a 64-bit build is byte-compiling code, some of its native fixnums | 3241 ;; When a 64-bit build is byte-compiling code, some of its native fixnums |
| 3227 ;; will not be represented as fixnums if the byte-compiled code is read by | 3242 ;; will not be represented as fixnums if the byte-compiled code is read by |
| 3228 ;; the Lisp reader in a 32-bit build. So in that case we need to check the | 3243 ;; the Lisp reader in a 32-bit build. So in that case we need to check the |
| 3229 ;; range of fixnums as well as their types. XEmacs doesn't support machines | 3244 ;; range of fixnums as well as their types. XEmacs doesn't support machines |