* lisp/emacs-lisp/bytecomp.el (byte-compile-catch)
(byte-compile-unwind-protect, byte-compile-track-mouse) (byte-compile-condition-case, byte-compile-save-window-excursion): Provide a :fun-body alternative, so that info can be propagated from the surrounding context, as is the case for lexical scoping. * lisp/emacs-lisp/cconv.el (cconv-mutated, cconv-captured) (cconv-captured+mutated, cconv-lambda-candidates): Fix up declaration. (cconv-freevars): Minor cleanup. Fix handling of the error var in condition-case.
This commit is contained in:
parent
94d11cb577
commit
d779e73c22
3 changed files with 805 additions and 769 deletions
|
@ -2706,11 +2706,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
byte-compile-bound-variables))
|
||||
(bytecomp-body (cdr (cdr bytecomp-fun)))
|
||||
(bytecomp-doc (if (stringp (car bytecomp-body))
|
||||
(prog1 (car bytecomp-body)
|
||||
;; Discard the doc string
|
||||
;; unless it is the last element of the body.
|
||||
(if (cdr bytecomp-body)
|
||||
(setq bytecomp-body (cdr bytecomp-body))))))
|
||||
(prog1 (car bytecomp-body)
|
||||
;; Discard the doc string
|
||||
;; unless it is the last element of the body.
|
||||
(if (cdr bytecomp-body)
|
||||
(setq bytecomp-body (cdr bytecomp-body))))))
|
||||
(bytecomp-int (assq 'interactive bytecomp-body)))
|
||||
;; Process the interactive spec.
|
||||
(when bytecomp-int
|
||||
|
@ -4076,76 +4076,79 @@ if LFORMINFO is nil (meaning all bindings are dynamic)."
|
|||
|
||||
(defun byte-compile-catch (form)
|
||||
(byte-compile-form (car (cdr form)))
|
||||
(byte-compile-push-constant
|
||||
(byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect))
|
||||
(pcase (cddr form)
|
||||
(`(:fun-body ,f)
|
||||
(byte-compile-form `(list 'funcall ,f)))
|
||||
(body
|
||||
(byte-compile-push-constant
|
||||
(byte-compile-top-level (cons 'progn body) for-effect))))
|
||||
(byte-compile-out 'byte-catch 0))
|
||||
|
||||
(defun byte-compile-unwind-protect (form)
|
||||
(byte-compile-push-constant
|
||||
(byte-compile-top-level-body (cdr (cdr form)) t))
|
||||
(pcase (cddr form)
|
||||
(`(:fun-body ,f)
|
||||
(byte-compile-form `(list (list 'funcall ,f))))
|
||||
(handlers
|
||||
(byte-compile-push-constant
|
||||
(byte-compile-top-level-body handlers t))))
|
||||
(byte-compile-out 'byte-unwind-protect 0)
|
||||
(byte-compile-form-do-effect (car (cdr form)))
|
||||
(byte-compile-out 'byte-unbind 1))
|
||||
|
||||
(defun byte-compile-track-mouse (form)
|
||||
(byte-compile-form
|
||||
;; Use quote rather that #' here, because we don't want to go
|
||||
;; through the body again, which would lead to an infinite recursion:
|
||||
;; "byte-compile-track-mouse" (0xbffc98e4)
|
||||
;; "byte-compile-form" (0xbffc9c54)
|
||||
;; "byte-compile-top-level" (0xbffc9fd4)
|
||||
;; "byte-compile-lambda" (0xbffca364)
|
||||
;; "byte-compile-closure" (0xbffca6d4)
|
||||
;; "byte-compile-function-form" (0xbffcaa44)
|
||||
;; "byte-compile-form" (0xbffcadc0)
|
||||
;; "mapc" (0xbffcaf74)
|
||||
;; "byte-compile-funcall" (0xbffcb2e4)
|
||||
;; "byte-compile-form" (0xbffcb654)
|
||||
;; "byte-compile-track-mouse" (0xbffcb9d4)
|
||||
`(funcall '(lambda nil
|
||||
(track-mouse ,@(byte-compile-top-level-body (cdr form)))))))
|
||||
(pcase form
|
||||
(`(,_ :fun-body ,f) `(eval (list 'track-mouse (list 'funcall ,f))))
|
||||
(_ `(eval '(track-mouse ,@(byte-compile-top-level-body (cdr form))))))))
|
||||
|
||||
(defun byte-compile-condition-case (form)
|
||||
(let* ((var (nth 1 form))
|
||||
(byte-compile-bound-variables
|
||||
(if var (cons var byte-compile-bound-variables)
|
||||
byte-compile-bound-variables)))
|
||||
byte-compile-bound-variables))
|
||||
(fun-bodies (eq var :fun-body)))
|
||||
(byte-compile-set-symbol-position 'condition-case)
|
||||
(unless (symbolp var)
|
||||
(byte-compile-warn
|
||||
"`%s' is not a variable-name or nil (in condition-case)" var))
|
||||
(if fun-bodies (setq var (make-symbol "err")))
|
||||
(byte-compile-push-constant var)
|
||||
(byte-compile-push-constant (byte-compile-top-level
|
||||
(nth 2 form) for-effect))
|
||||
(let ((clauses (cdr (cdr (cdr form))))
|
||||
compiled-clauses)
|
||||
(while clauses
|
||||
(let* ((clause (car clauses))
|
||||
(condition (car clause)))
|
||||
(cond ((not (or (symbolp condition)
|
||||
(and (listp condition)
|
||||
(let ((syms condition) (ok t))
|
||||
(while syms
|
||||
(if (not (symbolp (car syms)))
|
||||
(setq ok nil))
|
||||
(setq syms (cdr syms)))
|
||||
ok))))
|
||||
(byte-compile-warn
|
||||
"`%s' is not a condition name or list of such (in condition-case)"
|
||||
(prin1-to-string condition)))
|
||||
;; ((not (or (eq condition 't)
|
||||
;; (and (stringp (get condition 'error-message))
|
||||
;; (consp (get condition 'error-conditions)))))
|
||||
;; (byte-compile-warn
|
||||
;; "`%s' is not a known condition name (in condition-case)"
|
||||
;; condition))
|
||||
)
|
||||
(push (cons condition
|
||||
(byte-compile-top-level-body
|
||||
(cdr clause) for-effect))
|
||||
compiled-clauses))
|
||||
(setq clauses (cdr clauses)))
|
||||
(byte-compile-push-constant (nreverse compiled-clauses)))
|
||||
(if fun-bodies
|
||||
(byte-compile-form `(list 'funcall ,(nth 2 form)))
|
||||
(byte-compile-push-constant
|
||||
(byte-compile-top-level (nth 2 form) for-effect)))
|
||||
(let ((compiled-clauses
|
||||
(mapcar
|
||||
(lambda (clause)
|
||||
(let ((condition (car clause)))
|
||||
(cond ((not (or (symbolp condition)
|
||||
(and (listp condition)
|
||||
(let ((ok t))
|
||||
(dolist (sym condition)
|
||||
(if (not (symbolp sym))
|
||||
(setq ok nil)))
|
||||
ok))))
|
||||
(byte-compile-warn
|
||||
"`%S' is not a condition name or list of such (in condition-case)"
|
||||
condition))
|
||||
;; (not (or (eq condition 't)
|
||||
;; (and (stringp (get condition 'error-message))
|
||||
;; (consp (get condition
|
||||
;; 'error-conditions)))))
|
||||
;; (byte-compile-warn
|
||||
;; "`%s' is not a known condition name
|
||||
;; (in condition-case)"
|
||||
;; condition))
|
||||
)
|
||||
(if fun-bodies
|
||||
`(list ',condition (list 'funcall ,(cadr clause) ',var))
|
||||
(cons condition
|
||||
(byte-compile-top-level-body
|
||||
(cdr clause) for-effect)))))
|
||||
(cdr (cdr (cdr form))))))
|
||||
(if fun-bodies
|
||||
(byte-compile-form `(list ,@compiled-clauses))
|
||||
(byte-compile-push-constant compiled-clauses)))
|
||||
(byte-compile-out 'byte-condition-case 0)))
|
||||
|
||||
|
||||
|
@ -4168,8 +4171,12 @@ if LFORMINFO is nil (meaning all bindings are dynamic)."
|
|||
(byte-compile-out 'byte-unbind 1))
|
||||
|
||||
(defun byte-compile-save-window-excursion (form)
|
||||
(byte-compile-push-constant
|
||||
(byte-compile-top-level-body (cdr form) for-effect))
|
||||
(pcase (cdr form)
|
||||
(`(:fun-body ,f)
|
||||
(byte-compile-form `(list (list 'funcall ,f))))
|
||||
(body
|
||||
(byte-compile-push-constant
|
||||
(byte-compile-top-level-body body for-effect))))
|
||||
(byte-compile-out 'byte-save-window-excursion 0))
|
||||
|
||||
(defun byte-compile-with-output-to-temp-buffer (form)
|
||||
|
|
File diff suppressed because it is too large
Load diff
Loading…
Add table
Add a link
Reference in a new issue