Commit f68f2eb4 authored by Stefan Monnier's avatar Stefan Monnier

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

(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.
parent 6a3c5f41
Pipeline #341 failed with stage
in 2 seconds
...@@ -305,6 +305,7 @@ the node "(emacs) Directory Variables" of the user manual. ...@@ -305,6 +305,7 @@ the node "(emacs) Directory Variables" of the user manual.
* Changes in Specialized Modes and Packages in Emacs 27.1 * Changes in Specialized Modes and Packages in Emacs 27.1
** map.el ** map.el
*** Now also understands plists
*** Now defined via generic functions that can be extended via cl-defmethod. *** 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. *** 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.
......
...@@ -97,6 +97,9 @@ Returns the result of evaluating the form associated with MAP-VAR's type." ...@@ -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") (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) (cl-defgeneric map-elt (map key &optional default testfn)
"Lookup KEY in MAP and return its associated value. "Lookup KEY in MAP and return its associated value.
If KEY is not found, return DEFAULT which defaults to nil. 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." ...@@ -122,7 +125,12 @@ In the base definition, MAP can be an alist, hash-table, or array."
;; `testfn' is deprecated. ;; `testfn' is deprecated.
(advertised-calling-convention (map key &optional default) "27.1")) (advertised-calling-convention (map key &optional default) "27.1"))
(map--dispatch map (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) :hash-table (gethash key map default)
:array (if (and (>= key 0) (< key (seq-length map))) :array (if (and (>= key 0) (< key (seq-length map)))
(seq-elt map key) (seq-elt map key)
...@@ -138,14 +146,31 @@ MAP can be a list, hash-table or array." ...@@ -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")) (declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1"))
`(setf (map-elt ,map ,key nil ,testfn) ,value)) `(setf (map-elt ,map ,key nil ,testfn) ,value))
(cl-defgeneric map-delete (map key) (defun map--plist-delete (map key)
"Delete KEY from MAP and return MAP. (let ((tail map) last)
No error is signaled if KEY is not a key of MAP. If MAP is an (while (consp tail)
array, store nil at the index KEY. (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 (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) :hash-table (remhash key map)
:array (and (>= key 0) :array (and (>= key 0)
(<= key (seq-length map)) (<= key (seq-length map))
...@@ -164,29 +189,37 @@ Map can be a nested map composed of alists, hash-tables and arrays." ...@@ -164,29 +189,37 @@ Map can be a nested map composed of alists, hash-tables and arrays."
default)) default))
(cl-defgeneric map-keys (map) (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)) (map-apply (lambda (key _) key) map))
(cl-defgeneric map-values (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)) (map-apply (lambda (_ value) value) map))
(cl-defgeneric map-pairs (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)) (map-apply #'cons map))
(cl-defgeneric map-length (map) (cl-defgeneric map-length (map)
;; FIXME: Should we rename this to `map-size'? ;; 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 (cond
((hash-table-p map) (hash-table-count map)) ((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))))) (t (length (map-keys map)))))
(cl-defgeneric map-copy (map) (cl-defgeneric map-copy (map)
"Return a copy of MAP." "Return a copy of MAP."
;; FIXME: Clarify how deep is the copy!
(map--dispatch map (map--dispatch map
:list (seq-copy map) :list (seq-copy map) ;FIXME: Probably not deep enough for alists!
:hash-table (copy-hash-table map) :hash-table (copy-hash-table map)
:array (seq-copy map))) :array (seq-copy map)))
...@@ -337,9 +370,14 @@ MAP can be a list, hash-table or array." ...@@ -337,9 +370,14 @@ MAP can be a list, hash-table or array."
"Convert the map MAP into a map of type TYPE.") "Convert the map MAP into a map of type TYPE.")
;; FIXME: I wish there was a way to avoid this η-redex! ;; 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 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) (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 If KEY is already present in MAP, replace the associated value
with VALUE. with VALUE.
This operates by modifying MAP in place. This operates by modifying MAP in place.
...@@ -348,10 +386,13 @@ If you want to insert an element without modifying MAP, use `map-insert'." ...@@ -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'! ;; `testfn' only exists for backward compatibility with `map-put'!
(declare (advertised-calling-convention (map key value) "27.1")) (declare (advertised-calling-convention (map key value) "27.1"))
(map--dispatch map (map--dispatch map
:list (let ((oldmap map)) :list
(setf (alist-get key map key nil (or testfn #'equal)) value) (if (map--plist-p map)
(unless (eq oldmap map) (plist-put map key value)
(signal 'map-not-inplace (list map)))) (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) :hash-table (puthash key value map)
;; FIXME: If `key' is too large, should we signal `map-not-inplace' ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
;; and let `map-insert' grow the array? ;; and let `map-insert' grow the array?
...@@ -364,7 +405,9 @@ If you want to insert an element without modifying MAP, use `map-insert'." ...@@ -364,7 +405,9 @@ If you want to insert an element without modifying MAP, use `map-insert'."
This does not modify MAP. This does not modify MAP.
If you want to insert an element in place, use `map-put!'." If you want to insert an element in place, use `map-put!'."
(if (listp map) (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! ? ;; FIXME: Should we signal an error or use copy+put! ?
(signal 'map-inplace (list map)))) (signal 'map-inplace (list map))))
...@@ -374,11 +417,13 @@ If you want to insert an element in place, use `map-put!'." ...@@ -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") (define-obsolete-function-alias 'map--put #'map-put! "27.1")
(cl-defmethod map-apply (function (map list)) (cl-defmethod map-apply (function (map list))
(seq-map (lambda (pair) (if (map--plist-p map)
(funcall function (cl-call-next-method)
(car pair) (seq-map (lambda (pair)
(cdr pair))) (funcall function
map)) (car pair)
(cdr pair)))
map)))
(cl-defmethod map-apply (function (map hash-table)) (cl-defmethod map-apply (function (map hash-table))
(let (result) (let (result)
...@@ -395,13 +440,16 @@ If you want to insert an element in place, use `map-put!'." ...@@ -395,13 +440,16 @@ If you want to insert an element in place, use `map-put!'."
(setq index (1+ index)))) (setq index (1+ index))))
map))) map)))
(cl-defmethod map-do (function (alist list)) (cl-defmethod map-do (function (map list))
"Private function used to iterate over ALIST using FUNCTION." "Private function used to iterate over ALIST using FUNCTION."
(seq-do (lambda (pair) (if (map--plist-p map)
(funcall function (while map
(car pair) (funcall function (pop map) (pop map)))
(cdr pair))) (seq-do (lambda (pair)
alist)) (funcall function
(car pair)
(cdr pair)))
map)))
(cl-defmethod map-do (function (array array)) (cl-defmethod map-do (function (array array))
"Private function used to iterate over ARRAY using FUNCTION." "Private function used to iterate over ARRAY using FUNCTION."
......
...@@ -38,17 +38,19 @@ Evaluate BODY for each created map. ...@@ -38,17 +38,19 @@ Evaluate BODY for each created map.
\(fn (var map) body)" \(fn (var map) body)"
(declare (indent 1) (debug (symbolp body))) (declare (indent 1) (debug (symbolp body)))
(let ((alist (make-symbol "alist")) (let ((alist (make-symbol "alist"))
(plist (make-symbol "plist"))
(vec (make-symbol "vec")) (vec (make-symbol "vec"))
(ht (make-symbol "ht"))) (ht (make-symbol "ht")))
`(let ((,alist (list (cons 0 3) `(let ((,alist (list (cons 0 3)
(cons 1 4) (cons 1 4)
(cons 2 5))) (cons 2 5)))
(,plist (list 0 3 1 4 2 5))
(,vec (vector 3 4 5)) (,vec (vector 3 4 5))
(,ht (make-hash-table))) (,ht (make-hash-table)))
(puthash 0 3 ,ht) (puthash 0 3 ,ht)
(puthash 1 4 ,ht) (puthash 1 4 ,ht)
(puthash 2 5 ,ht) (puthash 2 5 ,ht)
(dolist (,var (list ,alist ,vec ,ht)) (dolist (,var (list ,alist ,plist ,vec ,ht))
,@body)))) ,@body))))
(ert-deftest test-map-elt () (ert-deftest test-map-elt ()
...@@ -86,7 +88,8 @@ Evaluate BODY for each created map. ...@@ -86,7 +88,8 @@ Evaluate BODY for each created map.
(with-maps-do map (with-maps-do map
(map-put! map 2 'hello) (map-put! map 2 'hello)
(should (eq (map-elt 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) (should-error (map-put! map 5 'value)
;; For vectors, it could arguably signal ;; For vectors, it could arguably signal
;; map-not-inplace as well, but it currently doesn't. ;; map-not-inplace as well, but it currently doesn't.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment