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,13 +43,14 @@ BEGIN {
END {
print ")))";
print " (mapc #'(lambda (x)";
print " (setcar x (decode-char 'japanese-jisx0208 (car x))))";
print " map)";
print " (setq map (mapcar (lambda (x)";
print " (cons (decode-char 'japanese-jisx0208 (car x))";
print " (cdr x)))";
print " map))";
print " (define-translation-table 'cp51932-decode map)";
print " (mapc #'(lambda (x)";
print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))";
print " (mapc (lambda (x)";
print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)";
print " (define-translation-table 'cp51932-encode map))";
print "";

View file

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

View file

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

View file

@ -1509,7 +1509,7 @@
byte-current-buffer byte-stack-ref))
(defconst byte-compile-side-effect-free-ops
(nconc
(append
'(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-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate

View file

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

View file

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

View file

@ -82,9 +82,7 @@
(#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
)))
(define-translation-table 'japanese-ucs-jis-to-cp932-map map)
(mapc #'(lambda (x) (let ((tmp (car x)))
(setcar x (cdr x)) (setcdr x tmp)))
map)
(setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map))
(define-translation-table 'japanese-ucs-cp932-to-jis-map map))
;; 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])
(#x2b66 . [#x02E5 #x02E9])))
table)
(dolist (elt map)
(setcar elt (decode-char 'japanese-jisx0213-1 (car elt))))
(setq map
(mapcar (lambda (x) (cons (decode-char 'japanese-jisx0213-1 (car x))
(cdr x)))
map))
(setq table (make-translation-table-from-alist map))
(define-translation-table 'jisx0213-to-unicode table)
(define-translation-table 'unicode-to-jisx0213

View file

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

View file

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

View file

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