mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-02-08 20:58:58 +00:00
Code Issues Releases Activity

* lisp/emacs-lisp/map.el: Add support for plists

Browse Source 
(map--plist-p, map--plist-delete): New functions.
(map-elt, map-delete, map-length, map-into, map-put!, map-insert)
(map-apply, map-do): Handle the plist case.

* test/lisp/emacs-lisp/map-tests.el (with-maps-do): Add sample plist.
(test-map-put!): The behavior of map-put! is not the same for plists as
for alists.
This commit is contained in:
Stefan Monnier 2018-12-20 08:40:43 -05:00
parent 6a3c5f415b
commit f68f2eb472
3 changed files with 84 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
etc/NEWS
View File

@ -305,6 +305,7 @@ the node "(emacs) Directory Variables" of the user manual.
* Changes in Specialized Modes and Packages in Emacs 27.1
** map.el
*** Now also understands plists
*** 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.

108
lisp/emacs-lisp/map.el
View File

@ -97,6 +97,9 @@ Returns the result of evaluating the form associated with MAP-VAR's type."
(define-error 'map-not-inplace "Cannot modify map in-place: %S")
(defsubst map--plist-p (list)
(and (consp list) (not (listp (car list)))))
(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.
@ -122,7 +125,12 @@ In the base definition, MAP can be an alist, hash-table, or array."
;; `testfn' is deprecated.
(advertised-calling-convention (map key &optional default) "27.1"))
(map--dispatch map
:list (alist-get key map default nil testfn)
:list (if (map--plist-p map)
(let ((res (plist-get map key)))
(if (and default (null res) (not (plist-member map key)))
default
res))
(alist-get key map default nil testfn))
:hash-table (gethash key map default)
:array (if (and (>= key 0) (< key (seq-length map)))
(seq-elt map key)
@ -138,14 +146,31 @@ MAP can be a list, hash-table or array."
(declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1"))
`(setf (map-elt ,map ,key nil ,testfn) ,value))
(cl-defgeneric map-delete (map key)
"Delete KEY from MAP and return MAP.
No error is signaled if KEY is not a key of MAP. If MAP is an
array, store nil at the index KEY.
(defun map--plist-delete (map key)
(let ((tail map) last)
(while (consp tail)
(cond
((not (equal key (car tail)))
(setq last tail)
(setq tail (cddr last)))
(last
(setq tail (cddr tail))
(setf (cddr last) tail))
(t
(cl-assert (eq tail map))
(setq map (cddr map))
(setq tail map))))
map))
MAP can be a list, hash-table or array."
(cl-defgeneric map-delete (map key)
"Delete KEY in-place from MAP and return MAP.
No error is signaled if KEY is not a key of MAP.
If MAP is an array, store nil at the index KEY."
(map--dispatch map
:list (setf (alist-get key map nil t) nil)
;; FIXME: Signal map-not-inplace i.s.o returning a different list?
:list (if (map--plist-p map)
(setq map (map--plist-delete map key))
(setf (alist-get key map nil t) nil))
:hash-table (remhash key map)
:array (and (>= key 0)
(<= key (seq-length map))
@ -164,29 +189,37 @@ Map can be a nested map composed of alists, hash-tables and arrays."
default))
(cl-defgeneric map-keys (map)
"Return the list of keys in MAP."
"Return the list of keys in MAP.
The default implementation delegates to `map-apply'."
(map-apply (lambda (key _) key) map))
(cl-defgeneric map-values (map)
"Return the list of values in MAP."
"Return the list of values in MAP.
The default implementation delegates to `map-apply'."
(map-apply (lambda (_ value) value) map))
(cl-defgeneric map-pairs (map)
"Return the elements of MAP as key/value association lists."
"Return the elements of MAP as key/value association lists.
The default implementation delegates to `map-apply'."
(map-apply #'cons map))
(cl-defgeneric map-length (map)
;; FIXME: Should we rename this to `map-size'?
"Return the number of elements in the map."
"Return the number of elements in the map.
The default implementation counts `map-keys'."
(cond
((hash-table-p map) (hash-table-count map))
((or (listp map) (arrayp map)) (length map))
((listp map)
;; FIXME: What about repeated/shadowed keys?
(if (map--plist-p map) (/ (length map) 2) (length map)))
((arrayp map) (length map))
(t (length (map-keys map)))))
(cl-defgeneric map-copy (map)
"Return a copy of MAP."
;; FIXME: Clarify how deep is the copy!
(map--dispatch map
:list (seq-copy map)
:list (seq-copy map) ;FIXME: Probably not deep enough for alists!
:hash-table (copy-hash-table map)
:array (seq-copy map)))
@ -337,9 +370,14 @@ MAP can be a list, hash-table or array."
"Convert the map MAP into a map of type TYPE.")
;; FIXME: I wish there was a way to avoid this η-redex!
(cl-defmethod map-into (map (_type (eql list))) (map-pairs map))
(cl-defmethod map-into (map (_type (eql alist))) (map-pairs map))
(cl-defmethod map-into (map (_type (eql plist)))
(let ((plist '()))
(map-do (lambda (k v) (setq plist `(,k ,v ,@plist))) map)
plist))
(cl-defgeneric map-put! (map key value &optional testfn)
"Associate KEY with VALUE in MAP and return VALUE.
"Associate KEY with VALUE in MAP.
If KEY is already present in MAP, replace the associated value
with VALUE.
This operates by modifying MAP in place.
@ -348,10 +386,13 @@ 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 ((oldmap map))
(setf (alist-get key map key nil (or testfn #'equal)) value)
(unless (eq oldmap map)
(signal 'map-not-inplace (list map))))
:list
(if (map--plist-p map)
(plist-put map key value)
(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?
@ -364,7 +405,9 @@ If you want to insert an element without modifying MAP, use `map-insert'."
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)
(if (map--plist-p map)
`(,key ,value ,@map)
(cons (cons key value) map))
;; FIXME: Should we signal an error or use copy+put! ?
(signal 'map-inplace (list map))))
@ -374,11 +417,13 @@ If you want to insert an element in place, use `map-put!'."
(define-obsolete-function-alias 'map--put #'map-put! "27.1")
(cl-defmethod map-apply (function (map list))
(seq-map (lambda (pair)
(funcall function
(car pair)
(cdr pair)))
map))
(if (map--plist-p map)
(cl-call-next-method)
(seq-map (lambda (pair)
(funcall function
(car pair)
(cdr pair)))
map)))
(cl-defmethod map-apply (function (map hash-table))
(let (result)
@ -395,13 +440,16 @@ If you want to insert an element in place, use `map-put!'."
(setq index (1+ index))))
map)))
(cl-defmethod map-do (function (alist list))
(cl-defmethod map-do (function (map list))
"Private function used to iterate over ALIST using FUNCTION."
(seq-do (lambda (pair)
(funcall function
(car pair)
(cdr pair)))
alist))
(if (map--plist-p map)
(while map
(funcall function (pop map) (pop map)))
(seq-do (lambda (pair)
(funcall function
(car pair)
(cdr pair)))
map)))
(cl-defmethod map-do (function (array array))
"Private function used to iterate over ARRAY using FUNCTION."

7
test/lisp/emacs-lisp/map-tests.el
View File

@ -38,17 +38,19 @@ Evaluate BODY for each created map.
\(fn (var map) body)"
(declare (indent 1) (debug (symbolp body)))
(let ((alist (make-symbol "alist"))
(plist (make-symbol "plist"))
(vec (make-symbol "vec"))
(ht (make-symbol "ht")))
`(let ((,alist (list (cons 0 3)
(cons 1 4)
(cons 2 5)))
(,plist (list 0 3 1 4 2 5))
(,vec (vector 3 4 5))
(,ht (make-hash-table)))
(puthash 0 3 ,ht)
(puthash 1 4 ,ht)
(puthash 2 5 ,ht)
(dolist (,var (list ,alist ,vec ,ht))
(dolist (,var (list ,alist ,plist ,vec ,ht))
,@body))))
(ert-deftest test-map-elt ()
@ -86,7 +88,8 @@ Evaluate BODY for each created map.
(with-maps-do map
(map-put! map 2 'hello)
(should (eq (map-elt map 2) 'hello))
(if (not (hash-table-p map))
(if (not (or (hash-table-p map)
(and (listp map) (not (listp (car map)))))) ;plist!
(should-error (map-put! map 5 'value)
;; For vectors, it could arguably signal
;; map-not-inplace as well, but it currently doesn't.