comparison lisp/cl-macs.el @ 5614:281bf2b87915

Call #'cl-macroexpand-all in #'cl-transform-function-property 2011-12-21 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (cl-transform-function-property): Call #'cl-macroexpand-all when doing this, avoiding unpleasantness with defsetf and lexical variables. * cl-macs.el (assert): The previous change meant #'remove-if isn't necessarily available yet; use the :key argument with #'remove* instead.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 21 Dec 2011 16:54:30 +0000
parents 3152c2c21461
children b0d712bbc2a6
comparison
equal deleted inserted replaced
5613:a944c124b2d3 5614:281bf2b87915
290 (cons 'lambda (cdr (cl-transform-lambda (cdr symbol-or-lambda) 290 (cons 'lambda (cdr (cl-transform-lambda (cdr symbol-or-lambda)
291 'cl-none))) 291 'cl-none)))
292 symbol-or-lambda))) 292 symbol-or-lambda)))
293 293
294 (defun cl-transform-function-property (func prop form) 294 (defun cl-transform-function-property (func prop form)
295 `(put ',func ',prop #'(lambda ,@(cdr (cl-transform-lambda form func))))) 295 (cl-macroexpand-all
296 `(put ',func ',prop #'(lambda ,@(cdr (cl-transform-lambda form func))))
297 byte-compile-macro-environment))
296 298
297 (defconst lambda-list-keywords 299 (defconst lambda-list-keywords
298 '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) 300 '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
299 301
300 (defvar bind-block) (defvar bind-defs) (defvar bind-enquote) 302 (defvar bind-block) (defvar bind-defs) (defvar bind-enquote)
3052 Other args STRING and ARGS... are arguments to be passed to `error'. 3054 Other args STRING and ARGS... are arguments to be passed to `error'.
3053 They are not evaluated unless the assertion fails. If STRING is 3055 They are not evaluated unless the assertion fails. If STRING is
3054 omitted, a default message listing FORM itself is used." 3056 omitted, a default message listing FORM itself is used."
3055 (and (or (not (cl-compiling-file)) 3057 (and (or (not (cl-compiling-file))
3056 (< cl-optimize-speed 3) (= cl-optimize-safety 3)) 3058 (< cl-optimize-speed 3) (= cl-optimize-safety 3))
3057 (let ((sargs (and show-args (remove-if #'cl-const-expr-p (cdr form))))) 3059 (let ((sargs (and show-args
3060 ;; #'remove-if isn't necessarily available yet.
3061 (remove* t (cdr form) :key #'cl-const-expr-p))))
3058 (list 'progn 3062 (list 'progn
3059 (list 'or form 3063 (list 'or form
3060 (if string 3064 (if string
3061 (list* 'error string (append sargs args)) 3065 (list* 'error string (append sargs args))
3062 (list 'signal '(quote cl-assertion-failed) 3066 (list 'signal '(quote cl-assertion-failed)