Don’t attempt to modify constant conses

From a patch privately suggested by Mattias Engdegård on 2020-05-11
in a followup to Bug#40671.
* admin/charsets/cp51932.awk:
* admin/charsets/eucjp-ms.awk:
Generate code that does not modify constant conses.
* doc/misc/emacs-mime.texi (Encoding Customization):
* lisp/emacs-lisp/byte-opt.el (byte-compile-side-effect-free-ops):
* lisp/frameset.el (frameset-persistent-filter-alist):
* lisp/gnus/gnus-sum.el (gnus-article-mode-line-format-alist):
Use append instead of nconc.
* lisp/language/japanese.el (japanese-ucs-cp932-to-jis-map)
(jisx0213-to-unicode):
Use mapcar instead of mapc.
* lisp/language/lao-util.el (lao-transcription-consonant-alist)
(lao-transcription-vowel-alist):
* lisp/language/tibetan.el (tibetan-subjoined-transcription-alist):
Use copy-sequence.
* test/src/fns-tests.el (fns-tests-nreverse):
(fns-tests-sort, fns-tests-collate-sort)
(fns-tests-string-version-lessp, fns-tests-mapcan):
Use copy-sequence, vector, and list.
This commit is contained in:
Paul Eggert 2020-05-16 17:04:15 -07:00
parent a6ebca21b3
commit c7bc28bf03
10 changed files with 63 additions and 54 deletions

View file

@ -43,11 +43,12 @@ BEGIN {
END { END {
print ")))"; print ")))";
print " (mapc #'(lambda (x)"; print " (setq map (mapcar (lambda (x)";
print " (setcar x (decode-char 'japanese-jisx0208 (car x))))"; print " (cons (decode-char 'japanese-jisx0208 (car x))";
print " map)"; print " (cdr x)))";
print " map))";
print " (define-translation-table 'cp51932-decode map)"; print " (define-translation-table 'cp51932-decode map)";
print " (mapc #'(lambda (x)"; print " (mapc (lambda (x)";
print " (let ((tmp (car x)))"; print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))"; print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)"; print " map)";

View file

@ -93,15 +93,17 @@ function write_entry (unicode) {
END { END {
print ")))"; print ")))";
print " (mapc #'(lambda (x)"; print " (setq map";
print " (mapcar";
print " (lambda (x)";
print " (let ((code (logand (car x) #x7F7F)))"; print " (let ((code (logand (car x) #x7F7F)))";
print " (if (integerp (cdr x))"; print " (if (integerp (cdr x))";
print " (setcar x (decode-char 'japanese-jisx0208 code))"; print " (cons (decode-char 'japanese-jisx0208 code) (cdr x))";
print " (setcar x (decode-char 'japanese-jisx0212 code))"; print " (cons (decode-char 'japanese-jisx0212 code)"
print " (setcdr x (cadr x)))))"; print " (cadr x)))))";
print " map)"; print " map))";
print " (define-translation-table 'eucjp-ms-decode map)"; print " (define-translation-table 'eucjp-ms-decode map)";
print " (mapc #'(lambda (x)"; print " (mapc (lambda (x)";
print " (let ((tmp (car x)))"; print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))"; print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)"; print " map)";

View file

@ -917,7 +917,7 @@ Here's an example:
@lisp @lisp
(add-to-list 'gnus-newsgroup-variables 'mm-coding-system-priorities) (add-to-list 'gnus-newsgroup-variables 'mm-coding-system-priorities)
(setq gnus-parameters (setq gnus-parameters
(nconc (append
;; Some charsets are just examples! ;; Some charsets are just examples!
'(("^cn\\." ;; Chinese '(("^cn\\." ;; Chinese
(mm-coding-system-priorities (mm-coding-system-priorities

View file

@ -1509,7 +1509,7 @@
byte-current-buffer byte-stack-ref)) byte-current-buffer byte-stack-ref))
(defconst byte-compile-side-effect-free-ops (defconst byte-compile-side-effect-free-ops
(nconc (append
'(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref '(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1 byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate

View file

@ -396,7 +396,7 @@ Properties can be set with
;; or, if you're only changing a few items, ;; or, if you're only changing a few items,
;; ;;
;; (defvar my-filter-alist ;; (defvar my-filter-alist
;; (nconc '((my-param1 . :never) ;; (append '((my-param1 . :never)
;; (my-param2 . my-filtering-function)) ;; (my-param2 . my-filtering-function))
;; frameset-filter-alist) ;; frameset-filter-alist)
;; "My brief customized parameter filter alist.") ;; "My brief customized parameter filter alist.")
@ -405,7 +405,7 @@ Properties can be set with
;; ALWAYS taking care of not modifying the original lists; if you're ;; ALWAYS taking care of not modifying the original lists; if you're
;; going to do any modifying of my-filter-alist, please use ;; going to do any modifying of my-filter-alist, please use
;; ;;
;; (nconc '((my-param1 . :never) ...) ;; (append '((my-param1 . :never) ...)
;; (copy-sequence frameset-filter-alist)) ;; (copy-sequence frameset-filter-alist))
;; ;;
;; One thing you shouldn't forget is that they are alists, so searching ;; One thing you shouldn't forget is that they are alists, so searching
@ -445,7 +445,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
;;;###autoload ;;;###autoload
(defvar frameset-persistent-filter-alist (defvar frameset-persistent-filter-alist
(nconc (append
'((background-color . frameset-filter-sanitize-color) '((background-color . frameset-filter-sanitize-color)
(buffer-list . :never) (buffer-list . :never)
(buffer-predicate . :never) (buffer-predicate . :never)

View file

@ -1501,7 +1501,7 @@ the type of the variable (string, integer, character, etc).")
;; This is here rather than in gnus-art for compilation reasons. ;; This is here rather than in gnus-art for compilation reasons.
(defvar gnus-article-mode-line-format-alist (defvar gnus-article-mode-line-format-alist
(nconc '((?w (gnus-article-wash-status) ?s) (append '((?w (gnus-article-wash-status) ?s)
(?m (gnus-article-mime-part-status) ?s)) (?m (gnus-article-mime-part-status) ?s))
gnus-summary-mode-line-format-alist)) gnus-summary-mode-line-format-alist))

View file

@ -82,9 +82,7 @@
(#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE (#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
))) )))
(define-translation-table 'japanese-ucs-jis-to-cp932-map map) (define-translation-table 'japanese-ucs-jis-to-cp932-map map)
(mapc #'(lambda (x) (let ((tmp (car x))) (setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map))
(setcar x (cdr x)) (setcdr x tmp)))
map)
(define-translation-table 'japanese-ucs-cp932-to-jis-map map)) (define-translation-table 'japanese-ucs-cp932-to-jis-map map))
;; U+2014 (EM DASH) vs U+2015 (HORIZONTAL BAR) ;; U+2014 (EM DASH) vs U+2015 (HORIZONTAL BAR)
@ -241,8 +239,10 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
(#x2b65 . [#x02E9 #x02E5]) (#x2b65 . [#x02E9 #x02E5])
(#x2b66 . [#x02E5 #x02E9]))) (#x2b66 . [#x02E5 #x02E9])))
table) table)
(dolist (elt map) (setq map
(setcar elt (decode-char 'japanese-jisx0213-1 (car elt)))) (mapcar (lambda (x) (cons (decode-char 'japanese-jisx0213-1 (car x))
(cdr x)))
map))
(setq table (make-translation-table-from-alist map)) (setq table (make-translation-table-from-alist map))
(define-translation-table 'jisx0213-to-unicode table) (define-translation-table 'jisx0213-to-unicode table)
(define-translation-table 'unicode-to-jisx0213 (define-translation-table 'unicode-to-jisx0213

View file

@ -183,7 +183,9 @@
;; Semi-vowel-sign-lo and lower vowels are put under the letter. ;; Semi-vowel-sign-lo and lower vowels are put under the letter.
(defconst lao-transcription-consonant-alist (defconst lao-transcription-consonant-alist
(sort '(;; single consonants (sort
(copy-sequence
'(;; single consonants
("k" . "") ("k" . "")
("kh" . "") ("kh" . "")
("qh" . "") ("qh" . "")
@ -223,14 +225,16 @@
("hy" . ["ຫຍ"]) ("hy" . ["ຫຍ"])
("hn" . ["ຫນ"]) ("hn" . ["ຫນ"])
("hm" . ["ຫມ"]) ("hm" . ["ຫມ"])
) ))
(function (lambda (x y) (> (length (car x)) (length (car y))))))) (lambda (x y) (> (length (car x)) (length (car y))))))
(defconst lao-transcription-semi-vowel-alist (defconst lao-transcription-semi-vowel-alist
'(("r" . ""))) '(("r" . "")))
(defconst lao-transcription-vowel-alist (defconst lao-transcription-vowel-alist
(sort '(("a" . "") (sort
(copy-sequence
'(("a" . "")
("ar" . "") ("ar" . "")
("i" . "") ("i" . "")
("ii" . "") ("ii" . "")
@ -257,8 +261,8 @@
("ai" . "") ("ai" . "")
("ei" . "") ("ei" . "")
("ao" . ["ເົາ"]) ("ao" . ["ເົາ"])
("aM" . "")) ("aM" . "")))
(function (lambda (x y) (> (length (car x)) (length (car y))))))) (lambda (x y) (> (length (car x)) (length (car y))))))
;; Maa-sakod is put at the tail. ;; Maa-sakod is put at the tail.
(defconst lao-transcription-maa-sakod-alist (defconst lao-transcription-maa-sakod-alist

View file

@ -326,7 +326,9 @@
(defconst tibetan-subjoined-transcription-alist (defconst tibetan-subjoined-transcription-alist
(sort '(("+k" . "") (sort
(copy-sequence
'(("+k" . "")
("+kh" . "") ("+kh" . "")
("+g" . "") ("+g" . "")
("+gh" . "") ("+gh" . "")
@ -371,7 +373,7 @@
("+W" . "") ;; fixed form subscribed WA ("+W" . "") ;; fixed form subscribed WA
("+Y" . "") ;; fixed form subscribed YA ("+Y" . "") ;; fixed form subscribed YA
("+R" . "") ;; fixed form subscribed RA ("+R" . "") ;; fixed form subscribed RA
) ))
(lambda (x y) (> (length (car x)) (length (car y)))))) (lambda (x y) (> (length (car x)) (length (car y))))))
;;; ;;;

View file

@ -49,21 +49,21 @@
(should-error (nreverse)) (should-error (nreverse))
(should-error (nreverse 1)) (should-error (nreverse 1))
(should-error (nreverse (make-char-table 'foo))) (should-error (nreverse (make-char-table 'foo)))
(should (equal (nreverse "xyzzy") "yzzyx")) (should (equal (nreverse (copy-sequence "xyzzy")) "yzzyx"))
(let ((A [])) (let ((A (vector)))
(nreverse A) (nreverse A)
(should (equal A []))) (should (equal A [])))
(let ((A [0])) (let ((A (vector 0)))
(nreverse A) (nreverse A)
(should (equal A [0]))) (should (equal A [0])))
(let ((A [1 2 3 4])) (let ((A (vector 1 2 3 4)))
(nreverse A) (nreverse A)
(should (equal A [4 3 2 1]))) (should (equal A [4 3 2 1])))
(let ((A [1 2 3 4])) (let ((A (vector 1 2 3 4)))
(nreverse A) (nreverse A)
(nreverse A) (nreverse A)
(should (equal A [1 2 3 4]))) (should (equal A [1 2 3 4])))
(let* ((A [1 2 3 4]) (let* ((A (vector 1 2 3 4))
(B (nreverse (nreverse A)))) (B (nreverse (nreverse A))))
(should (equal A B)))) (should (equal A B))))
@ -146,13 +146,13 @@
;; Invalid UTF-8 sequences shall be indicated. How to create such strings? ;; Invalid UTF-8 sequences shall be indicated. How to create such strings?
(ert-deftest fns-tests-sort () (ert-deftest fns-tests-sort ()
(should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y))) (should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
'(-1 2 3 4 5 5 7 8 9))) '(-1 2 3 4 5 5 7 8 9)))
(should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y))) (should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
'(9 8 7 5 5 4 3 2 -1))) '(9 8 7 5 5 4 3 2 -1)))
(should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (< x y))) (should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
[-1 2 3 4 5 5 7 8 9])) [-1 2 3 4 5 5 7 8 9]))
(should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (> x y))) (should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
[9 8 7 5 5 4 3 2 -1])) [9 8 7 5 5 4 3 2 -1]))
(should (equal (should (equal
(sort (sort
@ -172,7 +172,7 @@
;; Punctuation and whitespace characters are relevant for POSIX. ;; Punctuation and whitespace characters are relevant for POSIX.
(should (should
(equal (equal
(sort '("11" "12" "1 1" "1 2" "1.1" "1.2") (sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b) (string-collate-lessp a b "POSIX"))) (lambda (a b) (string-collate-lessp a b "POSIX")))
'("1 1" "1 2" "1.1" "1.2" "11" "12"))) '("1 1" "1 2" "1.1" "1.2" "11" "12")))
;; Punctuation and whitespace characters are not taken into account ;; Punctuation and whitespace characters are not taken into account
@ -180,7 +180,7 @@
(when (eq system-type 'windows-nt) (when (eq system-type 'windows-nt)
(should (should
(equal (equal
(sort '("11" "12" "1 1" "1 2" "1.1" "1.2") (sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b) (lambda (a b)
(let ((w32-collate-ignore-punctuation t)) (let ((w32-collate-ignore-punctuation t))
(string-collate-lessp (string-collate-lessp
@ -190,7 +190,7 @@
;; Diacritics are different letters for POSIX, they sort lexicographical. ;; Diacritics are different letters for POSIX, they sort lexicographical.
(should (should
(equal (equal
(sort '("Ævar" "Agustín" "Adrian" "Eli") (sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b) (string-collate-lessp a b "POSIX"))) (lambda (a b) (string-collate-lessp a b "POSIX")))
'("Adrian" "Agustín" "Eli" "Ævar"))) '("Adrian" "Agustín" "Eli" "Ævar")))
;; Diacritics are sorted between similar letters for other locales, ;; Diacritics are sorted between similar letters for other locales,
@ -198,7 +198,7 @@
(when (eq system-type 'windows-nt) (when (eq system-type 'windows-nt)
(should (should
(equal (equal
(sort '("Ævar" "Agustín" "Adrian" "Eli") (sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b) (lambda (a b)
(let ((w32-collate-ignore-punctuation t)) (let ((w32-collate-ignore-punctuation t))
(string-collate-lessp (string-collate-lessp
@ -212,7 +212,7 @@
(should (not (string-version-lessp "foo20000.png" "foo12.png"))) (should (not (string-version-lessp "foo20000.png" "foo12.png")))
(should (string-version-lessp "foo.png" "foo2.png")) (should (string-version-lessp "foo.png" "foo2.png"))
(should (not (string-version-lessp "foo2.png" "foo.png"))) (should (not (string-version-lessp "foo2.png" "foo.png")))
(should (equal (sort '("foo12.png" "foo2.png" "foo1.png") (should (equal (sort (list "foo12.png" "foo2.png" "foo1.png")
'string-version-lessp) 'string-version-lessp)
'("foo1.png" "foo2.png" "foo12.png"))) '("foo1.png" "foo2.png" "foo12.png")))
(should (string-version-lessp "foo2" "foo1234")) (should (string-version-lessp "foo2" "foo1234"))
@ -432,9 +432,9 @@
(should-error (mapcan)) (should-error (mapcan))
(should-error (mapcan #'identity)) (should-error (mapcan #'identity))
(should-error (mapcan #'identity (make-char-table 'foo))) (should-error (mapcan #'identity (make-char-table 'foo)))
(should (equal (mapcan #'list '(1 2 3)) '(1 2 3))) (should (equal (mapcan #'list (list 1 2 3)) '(1 2 3)))
;; `mapcan' is destructive ;; `mapcan' is destructive
(let ((data '((foo) (bar)))) (let ((data (list (list 'foo) (list 'bar))))
(should (equal (mapcan #'identity data) '(foo bar))) (should (equal (mapcan #'identity data) '(foo bar)))
(should (equal data '((foo bar) (bar)))))) (should (equal data '((foo bar) (bar))))))