mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-17 10:06:13 +00:00
* lisp/emacs-lisp/map.el: Avoid special casing lists.
(map-not-inplace, map-inplace): New errors. (map-insert): New generic function. (map-put!): Signal map-not-inplace rather than a generic 'error'. (map-elt): Use map-not-inplace and map-insert to avoid hardcoding a special case for lists. * test/lisp/emacs-lisp/map-tests.el (test-map-put!): Rename from test-map-put. Also test the errors signaled.
This commit is contained in:
parent
2c3f7f9c45
commit
55838e4e6a
3
etc/NEWS
3
etc/NEWS
@ -307,8 +307,9 @@ the node "(emacs) Directory Variables" of the user manual.
|
||||
** map.el
|
||||
*** Now defined via generic functions that can be extended via cl-defmethod.
|
||||
*** Deprecate the 'map-put' macro in favor of a new 'map-put!' function.
|
||||
*** map-contains-key now returns a boolean rather than the key.
|
||||
*** 'map-contains-key' now returns a boolean rather than the key.
|
||||
*** Deprecate the 'testfn' args of 'map-elt' and 'map-contains-key'.
|
||||
*** New generic function 'map-insert'.
|
||||
|
||||
---
|
||||
** Follow mode
|
||||
|
@ -95,12 +95,13 @@ Returns the result of evaluating the form associated with MAP-VAR's type."
|
||||
(t (error "Unsupported map type `%S': %S"
|
||||
(type-of ,map-var) ,map-var)))))
|
||||
|
||||
(define-error 'map-not-inplace "Cannot modify map in-place: %S")
|
||||
|
||||
(cl-defgeneric map-elt (map key &optional default testfn)
|
||||
"Lookup KEY in MAP and return its associated value.
|
||||
If KEY is not found, return DEFAULT which defaults to nil.
|
||||
|
||||
TESTFN is deprecated. Its default depends on the MAP argument.
|
||||
If MAP is a list, the default is `eql' to lookup KEY.
|
||||
|
||||
In the base definition, MAP can be an alist, hash-table, or array."
|
||||
(declare
|
||||
@ -110,15 +111,16 @@ In the base definition, MAP can be an alist, hash-table, or array."
|
||||
(macroexp-let2* nil
|
||||
;; Eval them once and for all in the right order.
|
||||
((key key) (default default) (testfn testfn))
|
||||
`(if (listp ,mgetter)
|
||||
;; Special case the alist case, since it can't be handled by the
|
||||
;; map--put function.
|
||||
,(gv-get `(alist-get ,key (gv-synthetic-place
|
||||
,mgetter ,msetter)
|
||||
,default nil ,testfn)
|
||||
do)
|
||||
,(funcall do `(map-elt ,mgetter ,key ,default)
|
||||
(lambda (v) `(map-put! ,mgetter ,key ,v)))))))))
|
||||
(funcall do `(map-elt ,mgetter ,key ,default)
|
||||
(lambda (v)
|
||||
`(condition-case nil
|
||||
;; Silence warnings about the hidden 4th arg.
|
||||
(with-no-warnings (map-put! ,mgetter ,key ,v ,testfn))
|
||||
(map-not-inplace
|
||||
,(funcall msetter
|
||||
`(map-insert ,mgetter ,key ,v))))))))))
|
||||
;; `testfn' is deprecated.
|
||||
(advertised-calling-convention (map key &optional default) "27.1"))
|
||||
(map--dispatch map
|
||||
:list (alist-get key map default nil testfn)
|
||||
:hash-table (gethash key map default)
|
||||
@ -336,17 +338,36 @@ MAP can be a list, hash-table or array."
|
||||
;; FIXME: I wish there was a way to avoid this η-redex!
|
||||
(cl-defmethod map-into (map (_type (eql list))) (map-pairs map))
|
||||
|
||||
(cl-defgeneric map-put! (map key value)
|
||||
(cl-defgeneric map-put! (map key value &optional testfn)
|
||||
"Associate KEY with VALUE in MAP and return VALUE.
|
||||
If KEY is already present in MAP, replace the associated value
|
||||
with VALUE."
|
||||
with VALUE.
|
||||
This operates by modifying MAP in place.
|
||||
If it cannot do that, it signals the `map-not-inplace' error.
|
||||
If you want to insert an element without modifying MAP, use `map-insert'."
|
||||
;; `testfn' only exists for backward compatibility with `map-put'!
|
||||
(declare (advertised-calling-convention (map key value) "27.1"))
|
||||
(map--dispatch map
|
||||
:list (let ((p (assoc key map)))
|
||||
(if p (setcdr p value)
|
||||
(error "No place to change the mapping for %S" key)))
|
||||
:list (let ((oldmap map))
|
||||
(setf (alist-get key map key nil (or testfn #'equal)) value)
|
||||
(unless (eq oldmap map)
|
||||
(signal 'map-not-inplace (list map))))
|
||||
:hash-table (puthash key value map)
|
||||
;; FIXME: If `key' is too large, should we signal `map-not-inplace'
|
||||
;; and let `map-insert' grow the array?
|
||||
:array (aset map key value)))
|
||||
|
||||
(define-error 'map-inplace "Can only modify map in place: %S")
|
||||
|
||||
(cl-defgeneric map-insert (map key value)
|
||||
"Return a new map like MAP except that it associates KEY with VALUE.
|
||||
This does not modify MAP.
|
||||
If you want to insert an element in place, use `map-put!'."
|
||||
(if (listp map)
|
||||
(cons (cons key value) map)
|
||||
;; FIXME: Should we signal an error or use copy+put! ?
|
||||
(signal 'map-inplace (list map))))
|
||||
|
||||
;; There shouldn't be old source code referring to `map--put', yet we do
|
||||
;; need to keep it for backward compatibility with .elc files where the
|
||||
;; expansion of `setf' may call this function.
|
||||
|
@ -76,13 +76,25 @@ Evaluate BODY for each created map.
|
||||
'b
|
||||
'2))))
|
||||
|
||||
(ert-deftest test-map-put ()
|
||||
(ert-deftest test-map-put! ()
|
||||
(with-maps-do map
|
||||
(setf (map-elt map 2) 'hello)
|
||||
(should (eq (map-elt map 2) 'hello)))
|
||||
(with-maps-do map
|
||||
(map-put map 2 'hello)
|
||||
(should (eq (map-elt map 2) 'hello)))
|
||||
(with-maps-do map
|
||||
(map-put! map 2 'hello)
|
||||
(should (eq (map-elt map 2) 'hello))
|
||||
(if (not (hash-table-p map))
|
||||
(should-error (map-put! map 5 'value)
|
||||
;; For vectors, it could arguably signal
|
||||
;; map-not-inplace as well, but it currently doesn't.
|
||||
:type (if (listp map)
|
||||
'map-not-inplace
|
||||
'error))
|
||||
(map-put! map 5 'value)
|
||||
(should (eq (map-elt map 5) 'value))))
|
||||
(let ((ht (make-hash-table)))
|
||||
(setf (map-elt ht 2) 'a)
|
||||
(should (eq (map-elt ht 2)
|
||||
@ -92,7 +104,7 @@ Evaluate BODY for each created map.
|
||||
(should (eq (map-elt alist 2)
|
||||
'a)))
|
||||
(let ((vec [3 4 5]))
|
||||
(should-error (setf (map-elt vec 3) 6))))
|
||||
(should-error (setf (map-elt vec 3) 6))))
|
||||
|
||||
(ert-deftest test-map-put-alist-new-key ()
|
||||
"Regression test for Bug#23105."
|
||||
@ -105,9 +117,9 @@ Evaluate BODY for each created map.
|
||||
(let ((alist (list (cons "a" 1) (cons "b" 2)))
|
||||
;; Make sure to use a non-eq "a", even when compiled.
|
||||
(noneq-key (string ?a)))
|
||||
(map-put alist noneq-key 3 'equal)
|
||||
(map-put alist noneq-key 3 #'equal)
|
||||
(should-not (cddr alist))
|
||||
(map-put alist noneq-key 9)
|
||||
(map-put alist noneq-key 9 #'eql)
|
||||
(should (cddr alist))))
|
||||
|
||||
(ert-deftest test-map-put-return-value ()
|
||||
|
Loading…
Reference in New Issue
Block a user