1
0
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:
Mattias Engdegård 2022-06-03 20:31:10 +02:00
parent 175bc8e5a5
commit 6825e5686a
7 changed files with 100 additions and 74 deletions

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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,

View File

@ -0,0 +1,3 @@
;;; -*- lexical-binding: t -*-
(defun foo ()
(setq (a) nil))

View File

@ -0,0 +1,3 @@
;;; -*- lexical-binding: t -*-
(defun foo (a b)
(setq a 1 b))

View File

@ -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")