mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-07 15:21:46 +00:00
Code Issues Releases Activity

(byte-compile-keep-pending, byte-compile-file-form, byte-compile-lambda)

Browse Source 
(byte-compile-top-level-body, byte-compile-form)
(byte-compile-variable-ref, byte-compile-setq)
(byte-compile-setq-default, byte-compile-body)
(byte-compile-body-do-effect, byte-compile-and, byte-compile-or)
(batch-byte-compile): Give some more local variables with common names
a "bytecomp-" prefix to avoid masking warnings about free variables.
This commit is contained in:
Glenn Morris 2009-09-15 02:34:32 +00:00
parent fe6793d4f8
commit c276856990
1 changed files with 122 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

233
lisp/emacs-lisp/bytecomp.el
View File

@ -2234,17 +2234,17 @@ list that represents a doc string reference.
(insert (nth 2 info)))))
nil)
(defun byte-compile-keep-pending (form &optional handler)
(defun byte-compile-keep-pending (form &optional bytecomp-handler)
(if (memq byte-optimize '(t source))
(setq form (byte-optimize-form form t)))
(if handler
(if bytecomp-handler
(let ((for-effect t))
;; To avoid consing up monstrously large forms at load time, we split
;; the output regularly.
(and (memq (car-safe form) '(fset defalias))
(nthcdr 300 byte-compile-output)
(byte-compile-flush-pending))
(funcall handler form)
(funcall bytecomp-handler form)
(if for-effect
(byte-compile-discard)))
(byte-compile-form form t))
@ -2265,13 +2265,13 @@ list that represents a doc string reference.
(defun byte-compile-file-form (form)
(let ((byte-compile-current-form nil) ; close over this for warnings.
handler)
bytecomp-handler)
(cond
((not (consp form))
(byte-compile-keep-pending form))
((and (symbolp (car form))
(setq handler (get (car form) 'byte-hunk-handler)))
(cond ((setq form (funcall handler form))
(setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
(cond ((setq form (funcall bytecomp-handler form))
(byte-compile-flush-pending)
(byte-compile-output-file-form form))))
((eq form (setq form (macroexpand form byte-compile-macro-environment)))
@ -2704,76 +2704,79 @@ If FORM is a lambda or a macro, byte-compile it as a function."
;; of the list FUN and `byte-compile-set-symbol-position' is not called.
;; Use this feature to avoid calling `byte-compile-set-symbol-position'
;; for symbols generated by the byte compiler itself.
(defun byte-compile-lambda (fun &optional add-lambda)
(defun byte-compile-lambda (bytecomp-fun &optional add-lambda)
(if add-lambda
(setq fun (cons 'lambda fun))
(unless (eq 'lambda (car-safe fun))
(error "Not a lambda list: %S" fun))
(setq bytecomp-fun (cons 'lambda bytecomp-fun))
(unless (eq 'lambda (car-safe bytecomp-fun))
(error "Not a lambda list: %S" bytecomp-fun))
(byte-compile-set-symbol-position 'lambda))
(byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
(byte-compile-check-lambda-list (nth 1 bytecomp-fun))
(let* ((bytecomp-arglist (nth 1 bytecomp-fun))
(byte-compile-bound-variables
(nconc (and (byte-compile-warning-enabled-p 'free-vars)
(delq '&rest (delq '&optional (copy-sequence arglist))))
(delq '&rest
(delq '&optional (copy-sequence bytecomp-arglist))))
byte-compile-bound-variables))
(body (cdr (cdr fun)))
(doc (if (stringp (car body))
(prog1 (car body)
(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 body)
(setq body (cdr body))))))
(int (assq 'interactive body)))
(if (cdr bytecomp-body)
(setq bytecomp-body (cdr bytecomp-body))))))
(bytecomp-int (assq 'interactive bytecomp-body)))
;; Process the interactive spec.
(when int
(when bytecomp-int
(byte-compile-set-symbol-position 'interactive)
;; Skip (interactive) if it is in front (the most usual location).
(if (eq int (car body))
(setq body (cdr body)))
(cond ((consp (cdr int))
(if (cdr (cdr int))
(if (eq bytecomp-int (car bytecomp-body))
(setq bytecomp-body (cdr bytecomp-body)))
(cond ((consp (cdr bytecomp-int))
(if (cdr (cdr bytecomp-int))
(byte-compile-warn "malformed interactive spec: %s"
(prin1-to-string int)))
(prin1-to-string bytecomp-int)))
;; If the interactive spec is a call to `list', don't
;; compile it, because `call-interactively' looks at the
;; args of `list'. Actually, compile it to get warnings,
;; but don't use the result.
(let ((form (nth 1 int)))
(let ((form (nth 1 bytecomp-int)))
(while (memq (car-safe form) '(let let* progn save-excursion))
(while (consp (cdr form))
(setq form (cdr form)))
(setq form (car form)))
(if (eq (car-safe form) 'list)
(byte-compile-top-level (nth 1 int))
(setq int (list 'interactive
(byte-compile-top-level (nth 1 int)))))))
((cdr int)
(byte-compile-top-level (nth 1 bytecomp-int))
(setq bytecomp-int (list 'interactive
(byte-compile-top-level
(nth 1 bytecomp-int)))))))
((cdr bytecomp-int)
(byte-compile-warn "malformed interactive spec: %s"
(prin1-to-string int)))))
(prin1-to-string bytecomp-int)))))
;; Process the body.
(let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
(let ((compiled (byte-compile-top-level
(cons 'progn bytecomp-body) nil 'lambda)))
;; Build the actual byte-coded function.
(if (and (eq 'byte-code (car-safe compiled))
(not (byte-compile-version-cond
byte-compile-compatibility)))
(apply 'make-byte-code
(append (list arglist)
(append (list bytecomp-arglist)
;; byte-string, constants-vector, stack depth
(cdr compiled)
;; optionally, the doc string.
(if (or doc int)
(list doc))
(if (or bytecomp-doc bytecomp-int)
(list bytecomp-doc))
;; optionally, the interactive spec.
(if int
(list (nth 1 int)))))
(if bytecomp-int
(list (nth 1 bytecomp-int)))))
(setq compiled
(nconc (if int (list int))
(nconc (if bytecomp-int (list bytecomp-int))
(cond ((eq (car-safe compiled) 'progn) (cdr compiled))
(compiled (list compiled)))))
(nconc (list 'lambda arglist)
(if (or doc (stringp (car compiled)))
(cons doc (cond (compiled)
(body (list nil))))
(nconc (list 'lambda bytecomp-arglist)
(if (or bytecomp-doc (stringp (car compiled)))
(cons bytecomp-doc (cond (compiled)
(bytecomp-body (list nil))))
compiled))))))
(defun byte-compile-constants-vector ()
@ -2917,13 +2920,14 @@ If FORM is a lambda or a macro, byte-compile it as a function."
((cdr body) (cons 'progn (nreverse body)))
((car body)))))
;; Given BODY, compile it and return a new body.
(defun byte-compile-top-level-body (body &optional for-effect)
(setq body (byte-compile-top-level (cons 'progn body) for-effect t))
(cond ((eq (car-safe body) 'progn)
(cdr body))
(body
(list body))))
;; Given BYTECOMP-BODY, compile it and return a new body.
(defun byte-compile-top-level-body (bytecomp-body &optional for-effect)
(setq bytecomp-body
(byte-compile-top-level (cons 'progn bytecomp-body) for-effect t))
(cond ((eq (car-safe bytecomp-body) 'progn)
(cdr bytecomp-body))
(bytecomp-body
(list bytecomp-body))))
(put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function)
(defun byte-compile-declare-function (form)
@ -2963,27 +2967,31 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(setq for-effect nil))
(t (byte-compile-variable-ref 'byte-varref form))))
((symbolp (car form))
(let* ((fn (car form))
(handler (get fn 'byte-compile)))
(when (byte-compile-const-symbol-p fn)
(byte-compile-warn "`%s' called as a function" fn))
(let* ((bytecomp-fn (car form))
(bytecomp-handler (get bytecomp-fn 'byte-compile)))
(when (byte-compile-const-symbol-p bytecomp-fn)
(byte-compile-warn "`%s' called as a function" bytecomp-fn))
(and (byte-compile-warning-enabled-p 'interactive-only)
(memq fn byte-compile-interactive-only-functions)
(memq bytecomp-fn byte-compile-interactive-only-functions)
(byte-compile-warn "`%s' used from Lisp code\n\
That command is designed for interactive use only" fn))
(if (and handler
That command is designed for interactive use only" bytecomp-fn))
(if (and bytecomp-handler
;; Make sure that function exists. This is important
;; for CL compiler macros since the symbol may be
;; `cl-byte-compile-compiler-macro' but if CL isn't
;; loaded, this function doesn't exist.
(or (not (memq handler '(cl-byte-compile-compiler-macro)))
(functionp handler))
(or (not (memq bytecomp-handler
'(cl-byte-compile-compiler-macro)))
(functionp bytecomp-handler))
(not (and (byte-compile-version-cond
byte-compile-compatibility)
(get (get fn 'byte-opcode) 'emacs19-opcode))))
(funcall handler form)
(get (get bytecomp-fn 'byte-opcode)
'emacs19-opcode))))
(funcall bytecomp-handler form)
(when (byte-compile-warning-enabled-p 'callargs)
(if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face))
(if (memq bytecomp-fn
'(custom-declare-group custom-declare-variable
custom-declare-face))
(byte-compile-nogroup-warn form))
(byte-compile-callargs-warn form))
(byte-compile-normal-call form))
@ -3012,37 +3020,40 @@ That command is designed for interactive use only" fn))
(mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
(byte-compile-out 'byte-call (length (cdr form))))
(defun byte-compile-variable-ref (base-op var)
(when (symbolp var)
(byte-compile-set-symbol-position var))
(if (or (not (symbolp var))
(byte-compile-const-symbol-p var (not (eq base-op 'byte-varref))))
(defun byte-compile-variable-ref (base-op bytecomp-var)
(when (symbolp bytecomp-var)
(byte-compile-set-symbol-position bytecomp-var))
(if (or (not (symbolp bytecomp-var))
(byte-compile-const-symbol-p bytecomp-var
(not (eq base-op 'byte-varref))))
(byte-compile-warn
(cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'")
((eq base-op 'byte-varset) "variable assignment to %s `%s'")
(t "variable reference to %s `%s'"))
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))
(and (get var 'byte-obsolete-variable)
(not (eq var byte-compile-not-obsolete-var))
(byte-compile-warn-obsolete var))
(if (symbolp bytecomp-var) "constant" "nonvariable")
(prin1-to-string bytecomp-var))
(and (get bytecomp-var 'byte-obsolete-variable)
(not (eq bytecomp-var byte-compile-not-obsolete-var))
(byte-compile-warn-obsolete bytecomp-var))
(if (byte-compile-warning-enabled-p 'free-vars)
(if (eq base-op 'byte-varbind)
(push var byte-compile-bound-variables)
(or (boundp var)
(memq var byte-compile-bound-variables)
(push bytecomp-var byte-compile-bound-variables)
(or (boundp bytecomp-var)
(memq bytecomp-var byte-compile-bound-variables)
(if (eq base-op 'byte-varset)
(or (memq var byte-compile-free-assignments)
(or (memq bytecomp-var byte-compile-free-assignments)
(progn
(byte-compile-warn "assignment to free variable `%s'" var)
(push var byte-compile-free-assignments)))
(or (memq var byte-compile-free-references)
(byte-compile-warn "assignment to free variable `%s'"
bytecomp-var)
(push bytecomp-var byte-compile-free-assignments)))
(or (memq bytecomp-var byte-compile-free-references)
(progn
(byte-compile-warn "reference to free variable `%s'" var)
(push var byte-compile-free-references))))))))
(let ((tmp (assq var byte-compile-variables)))
(byte-compile-warn "reference to free variable `%s'"
bytecomp-var)
(push bytecomp-var byte-compile-free-references))))))))
(let ((tmp (assq bytecomp-var byte-compile-variables)))
(unless tmp
(setq tmp (list var))
(setq tmp (list bytecomp-var))
(push tmp byte-compile-variables))
(byte-compile-out base-op tmp)))
@ -3534,32 +3545,32 @@ That command is designed for interactive use only" fn))
(byte-defop-compiler-1 quote-form)
(defun byte-compile-setq (form)
(let ((args (cdr form)))
(if args
(while args
(byte-compile-form (car (cdr args)))
(or for-effect (cdr (cdr args))
(let ((bytecomp-args (cdr form)))
(if bytecomp-args
(while bytecomp-args
(byte-compile-form (car (cdr bytecomp-args)))
(or for-effect (cdr (cdr bytecomp-args))
(byte-compile-out 'byte-dup 0))
(byte-compile-variable-ref 'byte-varset (car args))
(setq args (cdr (cdr args))))
(byte-compile-variable-ref 'byte-varset (car bytecomp-args))
(setq bytecomp-args (cdr (cdr bytecomp-args))))
;; (setq), with no arguments.
(byte-compile-form nil for-effect))
(setq for-effect nil)))
(defun byte-compile-setq-default (form)
(let ((args (cdr form))
(let ((bytecomp-args (cdr form))
setters)
(while args
(let ((var (car args)))
(while bytecomp-args
(let ((var (car bytecomp-args)))
(if (or (not (symbolp var))
(byte-compile-const-symbol-p var t))
(byte-compile-warn
"variable assignment to %s `%s'"
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var)))
(push (list 'set-default (list 'quote var) (car (cdr args)))
(push (list 'set-default (list 'quote var) (car (cdr bytecomp-args)))
setters))
(setq args (cdr (cdr args))))
(setq bytecomp-args (cdr (cdr bytecomp-args))))
(byte-compile-form (cons 'progn (nreverse setters)))))
(defun byte-compile-quote (form)
@ -3571,14 +3582,14 @@ That command is designed for interactive use only" fn))
;;; control structures
(defun byte-compile-body (body &optional for-effect)
(while (cdr body)
(byte-compile-form (car body) t)
(setq body (cdr body)))
(byte-compile-form (car body) for-effect))
(defun byte-compile-body (bytecomp-body &optional for-effect)
(while (cdr bytecomp-body)
(byte-compile-form (car bytecomp-body) t)
(setq bytecomp-body (cdr bytecomp-body)))
(byte-compile-form (car bytecomp-body) for-effect))
(defsubst byte-compile-body-do-effect (body)
(byte-compile-body body for-effect)
(defsubst byte-compile-body-do-effect (bytecomp-body)
(byte-compile-body bytecomp-body for-effect)
(setq for-effect nil))
(defsubst byte-compile-form-do-effect (form)
@ -3741,10 +3752,10 @@ that suppresses all warnings during execution of BODY."
(defun byte-compile-and (form)
(let ((failtag (byte-compile-make-tag))
(args (cdr form)))
(if (null args)
(bytecomp-args (cdr form)))
(if (null bytecomp-args)
(byte-compile-form-do-effect t)
(byte-compile-and-recursion args failtag))))
(byte-compile-and-recursion bytecomp-args failtag))))
;; Handle compilation of a nontrivial `and' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
@ -3760,10 +3771,10 @@ that suppresses all warnings during execution of BODY."
(defun byte-compile-or (form)
(let ((wintag (byte-compile-make-tag))
(args (cdr form)))
(if (null args)
(bytecomp-args (cdr form)))
(if (null bytecomp-args)
(byte-compile-form-do-effect nil)
(byte-compile-or-recursion args wintag))))
(byte-compile-or-recursion bytecomp-args wintag))))
;; Handle compilation of a nontrivial `or' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
@ -4328,7 +4339,7 @@ already up-to-date."
(defvar command-line-args-left) ;Avoid 'free variable' warning
(if (not noninteractive)
(error "`batch-byte-compile' is to be used only with -batch"))
(let ((error nil))
(let ((bytecomp-error nil))
(while command-line-args-left
(if (file-directory-p (expand-file-name (car command-line-args-left)))
;; Directory as argument.
@ -4345,7 +4356,7 @@ already up-to-date."
(file-exists-p bytecomp-dest)
(file-newer-than-file-p bytecomp-source bytecomp-dest))
(if (null (batch-byte-compile-file bytecomp-source))
(setq error t)))))
(setq bytecomp-error t)))))
;; Specific file argument
(if (or (not noforce)
(let* ((bytecomp-source (car command-line-args-left))
@ -4353,9 +4364,9 @@ already up-to-date."
(or (not (file-exists-p bytecomp-dest))
(file-newer-than-file-p bytecomp-source bytecomp-dest))))
(if (null (batch-byte-compile-file (car command-line-args-left)))
(setq error t))))
(setq bytecomp-error t))))
(setq command-line-args-left (cdr command-line-args-left)))
(kill-emacs (if error 1 0))))
(kill-emacs (if bytecomp-error 1 0))))
(defun batch-byte-compile-file (bytecomp-file)
(if debug-on-error