mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 06:20:55 -08:00
Fix merging of ambiguous nil maps
* lisp/emacs-lisp/map.el: Bump version to 3.1. (map--merge): New merging subroutine that uses a hash table in place of lists, for both efficiency and avoiding ambiguities (bug#49848). (map-merge): Rewrite in terms of map--merge. (map-merge-with): Ditto. This ensures that FUNCTION is called whenever two keys are merged, even if they are not eql (which could happen until now). It also makes map-merge-with consistent with map-merge, thus achieving greater overall predictability. * etc/NEWS: Announce this weakening of guarantees. * test/lisp/emacs-lisp/map-tests.el (test-map-merge) (test-map-merge-with): Don't depend on specific orderings. Test that nil is correctly merged into a plist.
This commit is contained in:
parent
1bfbb2b706
commit
37d48edf6d
3 changed files with 61 additions and 31 deletions
8
etc/NEWS
8
etc/NEWS
|
|
@ -1636,6 +1636,14 @@ This is a slightly deeper copy than the previous 'copy-sequence'.
|
||||||
---
|
---
|
||||||
*** The function 'map-contains-key' now supports plists.
|
*** The function 'map-contains-key' now supports plists.
|
||||||
|
|
||||||
|
---
|
||||||
|
*** More consistent duplicate key handling in 'map-merge-with'.
|
||||||
|
Until now, 'map-merge-with' promised to call its function argument
|
||||||
|
whenever multiple maps contained 'eql' keys. However, this did not
|
||||||
|
always coincide with the keys that were actually merged, which could
|
||||||
|
be 'equal' instead. The function argument is now called whenever keys
|
||||||
|
are merged, for greater consistency with 'map-merge' and 'map-elt'.
|
||||||
|
|
||||||
** Package
|
** Package
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,7 @@
|
||||||
;; Author: Nicolas Petton <nicolas@petton.fr>
|
;; Author: Nicolas Petton <nicolas@petton.fr>
|
||||||
;; Maintainer: emacs-devel@gnu.org
|
;; Maintainer: emacs-devel@gnu.org
|
||||||
;; Keywords: extensions, lisp
|
;; Keywords: extensions, lisp
|
||||||
;; Version: 3.0
|
;; Version: 3.1
|
||||||
;; Package-Requires: ((emacs "26"))
|
;; Package-Requires: ((emacs "26"))
|
||||||
|
|
||||||
;; This file is part of GNU Emacs.
|
;; This file is part of GNU Emacs.
|
||||||
|
|
@ -371,37 +371,51 @@ The default implementation delegates to `map-do'."
|
||||||
map)
|
map)
|
||||||
t))
|
t))
|
||||||
|
|
||||||
|
(defun map--merge (merge type &rest maps)
|
||||||
|
"Merge into a map of TYPE all the key/value pairs in MAPS.
|
||||||
|
MERGE is a function that takes the target MAP, a KEY, and a
|
||||||
|
VALUE, merges KEY and VALUE into MAP, and returns the result.
|
||||||
|
MAP may be of a type other than TYPE."
|
||||||
|
;; Use a hash table internally if `type' is a list. This avoids
|
||||||
|
;; both quadratic lookup behavior and the type ambiguity of nil.
|
||||||
|
(let* ((tolist (memq type '(list alist plist)))
|
||||||
|
(result (map-into (pop maps)
|
||||||
|
;; Use same testfn as `map-elt' gv setter.
|
||||||
|
(cond ((eq type 'plist) '(hash-table :test eq))
|
||||||
|
(tolist '(hash-table :test equal))
|
||||||
|
(type)))))
|
||||||
|
(dolist (map maps)
|
||||||
|
(map-do (lambda (key value)
|
||||||
|
(setq result (funcall merge result key value)))
|
||||||
|
map))
|
||||||
|
;; Convert internal representation to desired type.
|
||||||
|
(if tolist (map-into result type) result)))
|
||||||
|
|
||||||
(defun map-merge (type &rest maps)
|
(defun map-merge (type &rest maps)
|
||||||
"Merge into a map of TYPE all the key/value pairs in MAPS.
|
"Merge into a map of TYPE all the key/value pairs in MAPS.
|
||||||
See `map-into' for all supported values of TYPE."
|
See `map-into' for all supported values of TYPE."
|
||||||
(let ((result (map-into (pop maps) type)))
|
(apply #'map--merge
|
||||||
(while maps
|
(lambda (result key value)
|
||||||
;; FIXME: When `type' is `list', we get an O(N^2) behavior.
|
(setf (map-elt result key) value)
|
||||||
;; For small tables, this is fine, but for large tables, we
|
result)
|
||||||
;; should probably use a hash-table internally which we convert
|
type maps))
|
||||||
;; to an alist in the end.
|
|
||||||
(map-do (lambda (key value)
|
|
||||||
(setf (map-elt result key) value))
|
|
||||||
(pop maps)))
|
|
||||||
result))
|
|
||||||
|
|
||||||
(defun map-merge-with (type function &rest maps)
|
(defun map-merge-with (type function &rest maps)
|
||||||
"Merge into a map of TYPE all the key/value pairs in MAPS.
|
"Merge into a map of TYPE all the key/value pairs in MAPS.
|
||||||
When two maps contain the same (`eql') key, call FUNCTION on the two
|
When two maps contain the same key, call FUNCTION on the two
|
||||||
values and use the value returned by it.
|
values and use the value returned by it.
|
||||||
Each of MAPS can be an alist, plist, hash-table, or array.
|
Each of MAPS can be an alist, plist, hash-table, or array.
|
||||||
See `map-into' for all supported values of TYPE."
|
See `map-into' for all supported values of TYPE."
|
||||||
(let ((result (map-into (pop maps) type))
|
(let ((not-found (list nil)))
|
||||||
(not-found (list nil)))
|
(apply #'map--merge
|
||||||
(while maps
|
(lambda (result key value)
|
||||||
(map-do (lambda (key value)
|
(cl-callf (lambda (old)
|
||||||
(cl-callf (lambda (old)
|
(if (eql old not-found)
|
||||||
(if (eql old not-found)
|
value
|
||||||
value
|
(funcall function old value)))
|
||||||
(funcall function old value)))
|
(map-elt result key not-found))
|
||||||
(map-elt result key not-found)))
|
result)
|
||||||
(pop maps)))
|
type maps)))
|
||||||
result))
|
|
||||||
|
|
||||||
(cl-defgeneric map-into (map type)
|
(cl-defgeneric map-into (map type)
|
||||||
"Convert MAP into a map of TYPE.")
|
"Convert MAP into a map of TYPE.")
|
||||||
|
|
|
||||||
|
|
@ -446,16 +446,24 @@ Evaluate BODY for each created map."
|
||||||
|
|
||||||
(ert-deftest test-map-merge ()
|
(ert-deftest test-map-merge ()
|
||||||
"Test `map-merge'."
|
"Test `map-merge'."
|
||||||
(should (equal (map-merge 'list '(a 1) '((b . 2) (c . 3))
|
(should (equal (sort (map-merge 'list '(a 1) '((b . 2) (c . 3))
|
||||||
#s(hash-table data (c 4)))
|
#s(hash-table data (c 4)))
|
||||||
'((c . 4) (b . 2) (a . 1)))))
|
(lambda (x y) (string< (car x) (car y))))
|
||||||
|
'((a . 1) (b . 2) (c . 4))))
|
||||||
|
(should (equal (map-merge 'list () '(:a 1)) '((:a . 1))))
|
||||||
|
(should (equal (map-merge 'alist () '(:a 1)) '((:a . 1))))
|
||||||
|
(should (equal (map-merge 'plist () '(:a 1)) '(:a 1))))
|
||||||
|
|
||||||
(ert-deftest test-map-merge-with ()
|
(ert-deftest test-map-merge-with ()
|
||||||
(should (equal (map-merge-with 'list #'+
|
(should (equal (sort (map-merge-with 'list #'+
|
||||||
'((1 . 2))
|
'((1 . 2))
|
||||||
'((1 . 3) (2 . 4))
|
'((1 . 3) (2 . 4))
|
||||||
'((1 . 1) (2 . 5) (3 . 0)))
|
'((1 . 1) (2 . 5) (3 . 0)))
|
||||||
'((3 . 0) (2 . 9) (1 . 6)))))
|
#'car-less-than-car)
|
||||||
|
'((1 . 6) (2 . 9) (3 . 0))))
|
||||||
|
(should (equal (map-merge-with 'list #'+ () '(:a 1)) '((:a . 1))))
|
||||||
|
(should (equal (map-merge-with 'alist #'+ () '(:a 1)) '((:a . 1))))
|
||||||
|
(should (equal (map-merge-with 'plist #'+ () '(:a 1)) '(:a 1))))
|
||||||
|
|
||||||
(ert-deftest test-map-merge-empty ()
|
(ert-deftest test-map-merge-empty ()
|
||||||
"Test merging of empty maps."
|
"Test merging of empty maps."
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue