Mercurial > hg > xemacs-beta

comparison lisp/cl-macs.el @ 5570:6c76f5b7e2e3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Be more careful still in #'cl-defsubst-expand. lisp/ChangeLog addition: 2011-09-11 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (cl-defsubst-expand): Be more careful still here, make sure that any references to variables in BODY don't access those values in the enclosing scope when that would be inappropriate. Add some documentation of a potential reasonable approach to avoiding the problems with our (non-Common Lisp-conformant) #'symbol-macrolet.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 11 Sep 2011 16:05:05 +0100
parents d19b6e3bdf91
children d4f334808463
comparison
equal deleted inserted replaced
5569:d19b6e3bdf91 5570:6c76f5b7e2e3
3236 (let* ((symbol-macros nil) 3236 (let* ((symbol-macros nil)
3237 (lets (mapcan #'(lambda (argn argv) 3237 (lets (mapcan #'(lambda (argn argv)
3238 (if (or simple (cl-const-expr-p argv)) 3238 (if (or simple (cl-const-expr-p argv))
3239 (progn 3239 (progn
3240 ;; Avoid infinite loop on symbol macro 3240 ;; Avoid infinite loop on symbol macro
3241 ;; expansion, make sure none of the argvs 3241 ;; expansion:
3242 ;; refer to the symbols in the argns.
3243 (or (block find 3242 (or (block find
3244 ;; Can't use cl-expr-contains, that 3243 (subst nil argn argvs :test
3245 ;; doesn't descend lambdas: 3244 #'(lambda (elt tree)
3246 (subst nil argn argvs :test 3245 ;; Give nil if argn is
3247 #'(lambda (elt tree) 3246 ;; in argvs somewhere:
3248 (if (eq elt tree) 3247 (if (eq elt tree)
3249 (return-from find t)))) 3248 (return-from find)))))
3250 nil) 3249 (let ((copy-symbol (copy-symbol argn)))
3251 (push (list argn argv) symbol-macros)) 3250 ;; Rename ARGN within BODY so it
3252 (and unsafe (list (list argn argv)))) 3251 ;; doesn't conflict with its value
3252 ;; in the including scope:
3253 (setq body
3254 (cl-macroexpand-all
3255 body `((,(eq-hash argn)
3256 ,copy-symbol)))
3257 argn copy-symbol)))
3258 (push (list argn argv) symbol-macros)
3259 (and unsafe (list (list argn argv))))
3253 (list (list argn argv)))) 3260 (list (list argn argv))))
3254 argns argvs))) 3261 argns argvs)))
3255 `(let ,lets 3262 `(let ,lets
3256 (symbol-macrolet 3263 (symbol-macrolet
3257 ;; #### Bug; this will happily substitute in places where the 3264 ;; #### Bug; this will happily substitute in places where the
3258 ;; symbol is being shadowed in a different scope (e.g. inside 3265 ;; symbol is being shadowed in a different scope (e.g. inside
3259 ;; let bindings or lambda expressions where it has been 3266 ;; let bindings or lambda expressions where it has been
3260 ;; bound). We don't have GNU's issue where the replacement will 3267 ;; bound). We don't have GNU's issue where the replacement will
3261 ;; be done when the symbol is used in a function context, 3268 ;; be done when the symbol is used in a function context,
3262 ;; because we're using #'symbol-macrolet instead of #'subst. 3269 ;; because we're using #'symbol-macrolet instead of #'subst.
3270 ;;
3271 ;; #'symbol-macrolet as specified by Common Lisp is shadowed by
3272 ;; #'let, #'let* and lambda argument lists, and that would suit
3273 ;; our purposes here perfectly; we could implement it in
3274 ;; cl-macroexpand-all by shadowing any existing symbol macros
3275 ;; when we descend let forms or arglist lambdas. Doing it
3276 ;; unconditionally could well break #'loop, though.
3263 ,symbol-macros 3277 ,symbol-macros
3264 ,body))))) 3278 ,body)))))
3265 3279
3266 ;; When a 64-bit build is byte-compiling code, some of its native fixnums 3280 ;; When a 64-bit build is byte-compiling code, some of its native fixnums
3267 ;; will not be represented as fixnums if the byte-compiled code is read by 3281 ;; will not be represented as fixnums if the byte-compiled code is read by