mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-02 11:21:42 +00:00
Normalise setq during macro-expansion
Early normalisation of setq during macroexpand-all allows later stages, cconv, byte-opt and codegen, to be simplified and duplicated checks to be eliminated. * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Normalise all setq forms to a sequence of (setq VAR EXPR). Emit warnings if necessary. * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyze-form): * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): * lisp/emacs-lisp/bytecomp.el (byte-compile-setq): Simplify. * test/lisp/emacs-lisp/bytecomp-tests.el: Adapt and add tests. * test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-nonvariable.el; * test/lisp/emacs-lisp/bytecomp-resources/warn-variable-setq-odd.el: New files.
This commit is contained in:
parent
175bc8e5a5
commit
6825e5686a
@ -463,32 +463,21 @@ for speeding up processing.")
|
||||
;; is a *value* and shouldn't appear in the car.
|
||||
(`((closure . ,_) . ,_) form)
|
||||
|
||||
(`(setq . ,args)
|
||||
(let ((var-expr-list nil))
|
||||
(while args
|
||||
(unless (and (consp args)
|
||||
(symbolp (car args)) (consp (cdr args)))
|
||||
(byte-compile-warn-x form "malformed setq form: %S" form))
|
||||
(let* ((var (car args))
|
||||
(expr (cadr args))
|
||||
(lexvar (assq var byte-optimize--lexvars))
|
||||
(value (byte-optimize-form expr nil)))
|
||||
(when lexvar
|
||||
(setcar (cdr lexvar) t) ; Mark variable to be kept.
|
||||
(setcdr (cdr lexvar) nil) ; Inhibit further substitution.
|
||||
(`(setq ,var ,expr)
|
||||
(let ((lexvar (assq var byte-optimize--lexvars))
|
||||
(value (byte-optimize-form expr nil)))
|
||||
(when lexvar
|
||||
(setcar (cdr lexvar) t) ; Mark variable to be kept.
|
||||
(setcdr (cdr lexvar) nil) ; Inhibit further substitution.
|
||||
|
||||
(when (memq var byte-optimize--aliased-vars)
|
||||
;; Cancel aliasing of variables aliased to this one.
|
||||
(dolist (v byte-optimize--lexvars)
|
||||
(when (eq (nth 2 v) var)
|
||||
;; V is bound to VAR but VAR is now mutated:
|
||||
;; cancel aliasing.
|
||||
(setcdr (cdr v) nil)))))
|
||||
|
||||
(push var var-expr-list)
|
||||
(push value var-expr-list))
|
||||
(setq args (cddr args)))
|
||||
(cons fn (nreverse var-expr-list))))
|
||||
(when (memq var byte-optimize--aliased-vars)
|
||||
;; Cancel aliasing of variables aliased to this one.
|
||||
(dolist (v byte-optimize--lexvars)
|
||||
(when (eq (nth 2 v) var)
|
||||
;; V is bound to VAR but VAR is now mutated:
|
||||
;; cancel aliasing.
|
||||
(setcdr (cdr v) nil)))))
|
||||
`(,fn ,var ,value)))
|
||||
|
||||
(`(defvar ,(and (pred symbolp) name) . ,rest)
|
||||
(let ((optimized-rest (and rest
|
||||
|
@ -4225,25 +4225,13 @@ This function is never called when `lexical-binding' is nil."
|
||||
(byte-defop-compiler-1 quote)
|
||||
|
||||
(defun byte-compile-setq (form)
|
||||
(let* ((args (cdr form))
|
||||
(len (length args)))
|
||||
(if (= (logand len 1) 1)
|
||||
(progn
|
||||
(byte-compile-report-error
|
||||
(format-message
|
||||
"missing value for `%S' at end of setq" (car (last args))))
|
||||
(byte-compile-form
|
||||
`(signal 'wrong-number-of-arguments '(setq ,len))
|
||||
byte-compile--for-effect))
|
||||
(if args
|
||||
(while args
|
||||
(byte-compile-form (car (cdr args)))
|
||||
(or byte-compile--for-effect (cdr (cdr args))
|
||||
(byte-compile-out 'byte-dup 0))
|
||||
(byte-compile-variable-set (car args))
|
||||
(setq args (cdr (cdr args))))
|
||||
;; (setq), with no arguments.
|
||||
(byte-compile-form nil byte-compile--for-effect)))
|
||||
(cl-assert (= (length form) 3)) ; normalised in macroexp
|
||||
(let ((var (nth 1 form))
|
||||
(expr (nth 2 form)))
|
||||
(byte-compile-form expr)
|
||||
(unless byte-compile--for-effect
|
||||
(byte-compile-out 'byte-dup 0))
|
||||
(byte-compile-variable-set var)
|
||||
(setq byte-compile--for-effect nil)))
|
||||
|
||||
(byte-defop-compiler-1 set-default)
|
||||
|
@ -555,29 +555,19 @@ places where they originally did not directly appear."
|
||||
`(,(car form) ,(cconv-convert form1 env extend)
|
||||
:fun-body ,(cconv--convert-function () body env form1)))
|
||||
|
||||
(`(setq . ,forms) ; setq special form
|
||||
(if (= (logand (length forms) 1) 1)
|
||||
;; With an odd number of args, let bytecomp.el handle the error.
|
||||
form
|
||||
(let ((prognlist ()))
|
||||
(while forms
|
||||
(let* ((sym (pop forms))
|
||||
(sym-new (or (cdr (assq sym env)) sym))
|
||||
(value (cconv-convert (pop forms) env extend)))
|
||||
(push (pcase sym-new
|
||||
((pred symbolp) `(,(car form) ,sym-new ,value))
|
||||
(`(car-safe ,iexp) `(setcar ,iexp ,value))
|
||||
;; This "should never happen", but for variables which are
|
||||
;; mutated+captured+unused, we may end up trying to `setq'
|
||||
;; on a closed-over variable, so just drop the setq.
|
||||
(_ ;; (byte-compile-report-error
|
||||
;; (format "Internal error in cconv of (setq %s ..)"
|
||||
;; sym-new))
|
||||
value))
|
||||
prognlist)))
|
||||
(if (cdr prognlist)
|
||||
`(progn . ,(nreverse prognlist))
|
||||
(car prognlist)))))
|
||||
(`(setq ,var ,expr)
|
||||
(let ((var-new (or (cdr (assq var env)) var))
|
||||
(value (cconv-convert expr env extend)))
|
||||
(pcase var-new
|
||||
((pred symbolp) `(,(car form) ,var-new ,value))
|
||||
(`(car-safe ,iexp) `(setcar ,iexp ,value))
|
||||
;; This "should never happen", but for variables which are
|
||||
;; mutated+captured+unused, we may end up trying to `setq'
|
||||
;; on a closed-over variable, so just drop the setq.
|
||||
(_ ;; (byte-compile-report-error
|
||||
;; (format "Internal error in cconv of (setq %s ..)"
|
||||
;; sym-new))
|
||||
value))))
|
||||
|
||||
(`(,(and (or 'funcall 'apply) callsym) ,fun . ,args)
|
||||
;; These are not special forms but we treat them separately for the needs
|
||||
@ -751,14 +741,13 @@ This function does not return anything but instead fills the
|
||||
(cconv-analyze-form (cadr (pop body-forms)) env))
|
||||
(cconv--analyze-function vrs body-forms env form))
|
||||
|
||||
(`(setq . ,forms)
|
||||
(`(setq ,var ,expr)
|
||||
;; If a local variable (member of env) is modified by setq then
|
||||
;; it is a mutated variable.
|
||||
(while forms
|
||||
(let ((v (assq (car forms) env))) ; v = non nil if visible
|
||||
(when v (setf (nth 2 v) t)))
|
||||
(cconv-analyze-form (cadr forms) env)
|
||||
(setq forms (cddr forms))))
|
||||
(let ((v (assq var env))) ; v = non nil if visible
|
||||
(when v
|
||||
(setf (nth 2 v) t)))
|
||||
(cconv-analyze-form expr env))
|
||||
|
||||
(`((lambda . ,_) . ,_) ; First element is lambda expression.
|
||||
(byte-compile-warn-x
|
||||
|
@ -369,6 +369,54 @@ Assumes the caller has bound `macroexpand-all-environment'."
|
||||
(macroexp--all-forms body))
|
||||
(cdr form))
|
||||
form)))
|
||||
(`(setq ,(and var (pred symbolp)
|
||||
(pred (not booleanp)) (pred (not keywordp)))
|
||||
,expr)
|
||||
;; Fast path for the setq common case.
|
||||
(let ((new-expr (macroexp--expand-all expr)))
|
||||
(if (eq new-expr expr)
|
||||
form
|
||||
`(,fn ,var ,new-expr))))
|
||||
(`(setq . ,args)
|
||||
;; Normalise to a sequence of (setq SYM EXPR).
|
||||
;; Malformed code is translated to code that signals an error
|
||||
;; at run time.
|
||||
(let ((nargs (length args)))
|
||||
(if (/= (logand nargs 1) 0)
|
||||
(macroexp-warn-and-return
|
||||
"odd number of arguments in `setq' form"
|
||||
`(signal 'wrong-number-of-arguments '(setq ,nargs))
|
||||
nil 'compile-only fn)
|
||||
(let ((assignments nil))
|
||||
(while (consp (cdr-safe args))
|
||||
(let* ((var (car args))
|
||||
(expr (cadr args))
|
||||
(new-expr (macroexp--expand-all expr))
|
||||
(assignment
|
||||
(if (and (symbolp var)
|
||||
(not (booleanp var)) (not (keywordp var)))
|
||||
`(,fn ,var ,new-expr)
|
||||
(macroexp-warn-and-return
|
||||
(format-message "attempt to set %s `%s'"
|
||||
(if (symbolp var)
|
||||
"constant"
|
||||
"non-variable")
|
||||
var)
|
||||
(cond
|
||||
((keywordp var)
|
||||
;; Accept `(setq :a :a)' for compatibility.
|
||||
`(if (eq ,var ,new-expr)
|
||||
,var
|
||||
(signal 'setting-constant (list ',var))))
|
||||
((symbolp var)
|
||||
`(signal 'setting-constant (list ',var)))
|
||||
(t
|
||||
`(signal 'wrong-type-argument
|
||||
(list 'symbolp ',var))))
|
||||
nil 'compile-only var))))
|
||||
(push assignment assignments))
|
||||
(setq args (cddr args)))
|
||||
(cons 'progn (nreverse assignments))))))
|
||||
(`(,(and fun `(lambda . ,_)) . ,args)
|
||||
;; Embedded lambda in function position.
|
||||
;; If the byte-optimizer is loaded, try to unfold this,
|
||||
|
@ -0,0 +1,3 @@
|
||||
;;; -*- lexical-binding: t -*-
|
||||
(defun foo ()
|
||||
(setq (a) nil))
|
@ -0,0 +1,3 @@
|
||||
;;; -*- lexical-binding: t -*-
|
||||
(defun foo (a b)
|
||||
(setq a 1 b))
|
@ -951,11 +951,17 @@ byte-compiled. Run with dynamic binding."
|
||||
"let-bind nonvariable")
|
||||
|
||||
(bytecomp--define-warning-file-test "warn-variable-set-constant.el"
|
||||
"variable reference to constant")
|
||||
"attempt to set constant")
|
||||
|
||||
(bytecomp--define-warning-file-test "warn-variable-set-nonvariable.el"
|
||||
"variable reference to nonvariable")
|
||||
|
||||
(bytecomp--define-warning-file-test "warn-variable-setq-nonvariable.el"
|
||||
"attempt to set non-variable")
|
||||
|
||||
(bytecomp--define-warning-file-test "warn-variable-setq-odd.el"
|
||||
"odd number of arguments")
|
||||
|
||||
(bytecomp--define-warning-file-test
|
||||
"warn-wide-docstring-autoload.el"
|
||||
"autoload .foox. docstring wider than .* characters")
|
||||
|
Loading…
Reference in New Issue
Block a user