Commit d779e73c authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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.
parent 94d11cb5
2011-02-10 Stefan Monnier <monnier@iro.umontreal.ca>
* 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.
* 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.
2011-02-10 Igor Kuzmin <kuzminig@iro.umontreal.ca>
* emacs-lisp/cconv.el: New file.
......
......@@ -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)
......
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment