aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2018-12-20 08:40:43 -0500
committerStefan Monnier2018-12-20 08:40:43 -0500
commitf68f2eb47280cf92fdb41548e40b37e7a4a81e53 (patch)
tree069f12113b34c54c7b81f4dd388740b3f18458b5
parent6a3c5f415b15531751dbbe4686950dbc15927866 (diff)
downloademacs-f68f2eb47280cf92fdb41548e40b37e7a4a81e53.tar.gz
emacs-f68f2eb47280cf92fdb41548e40b37e7a4a81e53.zip
* 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.
-rw-r--r--etc/NEWS1
-rw-r--r--lisp/emacs-lisp/map.el108
-rw-r--r--test/lisp/emacs-lisp/map-tests.el7
3 files changed, 84 insertions, 32 deletions
diff --git a/etc/NEWS b/etc/NEWS
index bc76bec2d75..7ff4aee64b5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -305,6 +305,7 @@ the node "(emacs) Directory Variables" of the user manual.
305* Changes in Specialized Modes and Packages in Emacs 27.1 305* Changes in Specialized Modes and Packages in Emacs 27.1
306 306
307** map.el 307** map.el
308*** Now also understands plists
308*** Now defined via generic functions that can be extended via cl-defmethod. 309*** Now defined via generic functions that can be extended via cl-defmethod.
309*** Deprecate the 'map-put' macro in favor of a new 'map-put!' function. 310*** Deprecate the 'map-put' macro in favor of a new 'map-put!' function.
310*** 'map-contains-key' now returns a boolean rather than the key. 311*** 'map-contains-key' now returns a boolean rather than the key.
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index d5051fcd98a..53a1b3b171c 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -97,6 +97,9 @@ Returns the result of evaluating the form associated with MAP-VAR's type."
97 97
98(define-error 'map-not-inplace "Cannot modify map in-place: %S") 98(define-error 'map-not-inplace "Cannot modify map in-place: %S")
99 99
100(defsubst map--plist-p (list)
101 (and (consp list) (not (listp (car list)))))
102
100(cl-defgeneric map-elt (map key &optional default testfn) 103(cl-defgeneric map-elt (map key &optional default testfn)
101 "Lookup KEY in MAP and return its associated value. 104 "Lookup KEY in MAP and return its associated value.
102If KEY is not found, return DEFAULT which defaults to nil. 105If 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 ;; `testfn' is deprecated. 125 ;; `testfn' is deprecated.
123 (advertised-calling-convention (map key &optional default) "27.1")) 126 (advertised-calling-convention (map key &optional default) "27.1"))
124 (map--dispatch map 127 (map--dispatch map
125 :list (alist-get key map default nil testfn) 128 :list (if (map--plist-p map)
129 (let ((res (plist-get map key)))
130 (if (and default (null res) (not (plist-member map key)))
131 default
132 res))
133 (alist-get key map default nil testfn))
126 :hash-table (gethash key map default) 134 :hash-table (gethash key map default)
127 :array (if (and (>= key 0) (< key (seq-length map))) 135 :array (if (and (>= key 0) (< key (seq-length map)))
128 (seq-elt map key) 136 (seq-elt map key)
@@ -138,14 +146,31 @@ MAP can be a list, hash-table or array."
138 (declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1")) 146 (declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1"))
139 `(setf (map-elt ,map ,key nil ,testfn) ,value)) 147 `(setf (map-elt ,map ,key nil ,testfn) ,value))
140 148
141(cl-defgeneric map-delete (map key) 149(defun map--plist-delete (map key)
142 "Delete KEY from MAP and return MAP. 150 (let ((tail map) last)
143No error is signaled if KEY is not a key of MAP. If MAP is an 151 (while (consp tail)
144array, store nil at the index KEY. 152 (cond
153 ((not (equal key (car tail)))
154 (setq last tail)
155 (setq tail (cddr last)))
156 (last
157 (setq tail (cddr tail))
158 (setf (cddr last) tail))
159 (t
160 (cl-assert (eq tail map))
161 (setq map (cddr map))
162 (setq tail map))))
163 map))
145 164
146MAP can be a list, hash-table or array." 165(cl-defgeneric map-delete (map key)
166 "Delete KEY in-place from MAP and return MAP.
167No error is signaled if KEY is not a key of MAP.
168If MAP is an array, store nil at the index KEY."
147 (map--dispatch map 169 (map--dispatch map
148 :list (setf (alist-get key map nil t) nil) 170 ;; FIXME: Signal map-not-inplace i.s.o returning a different list?
171 :list (if (map--plist-p map)
172 (setq map (map--plist-delete map key))
173 (setf (alist-get key map nil t) nil))
149 :hash-table (remhash key map) 174 :hash-table (remhash key map)
150 :array (and (>= key 0) 175 :array (and (>= key 0)
151 (<= key (seq-length map)) 176 (<= key (seq-length map))
@@ -164,29 +189,37 @@ Map can be a nested map composed of alists, hash-tables and arrays."
164 default)) 189 default))
165 190
166(cl-defgeneric map-keys (map) 191(cl-defgeneric map-keys (map)
167 "Return the list of keys in MAP." 192 "Return the list of keys in MAP.
193The default implementation delegates to `map-apply'."
168 (map-apply (lambda (key _) key) map)) 194 (map-apply (lambda (key _) key) map))
169 195
170(cl-defgeneric map-values (map) 196(cl-defgeneric map-values (map)
171 "Return the list of values in MAP." 197 "Return the list of values in MAP.
198The default implementation delegates to `map-apply'."
172 (map-apply (lambda (_ value) value) map)) 199 (map-apply (lambda (_ value) value) map))
173 200
174(cl-defgeneric map-pairs (map) 201(cl-defgeneric map-pairs (map)
175 "Return the elements of MAP as key/value association lists." 202 "Return the elements of MAP as key/value association lists.
203The default implementation delegates to `map-apply'."
176 (map-apply #'cons map)) 204 (map-apply #'cons map))
177 205
178(cl-defgeneric map-length (map) 206(cl-defgeneric map-length (map)
179 ;; FIXME: Should we rename this to `map-size'? 207 ;; FIXME: Should we rename this to `map-size'?
180 "Return the number of elements in the map." 208 "Return the number of elements in the map.
209The default implementation counts `map-keys'."
181 (cond 210 (cond
182 ((hash-table-p map) (hash-table-count map)) 211 ((hash-table-p map) (hash-table-count map))
183 ((or (listp map) (arrayp map)) (length map)) 212 ((listp map)
213 ;; FIXME: What about repeated/shadowed keys?
214 (if (map--plist-p map) (/ (length map) 2) (length map)))
215 ((arrayp map) (length map))
184 (t (length (map-keys map))))) 216 (t (length (map-keys map)))))
185 217
186(cl-defgeneric map-copy (map) 218(cl-defgeneric map-copy (map)
187 "Return a copy of MAP." 219 "Return a copy of MAP."
220 ;; FIXME: Clarify how deep is the copy!
188 (map--dispatch map 221 (map--dispatch map
189 :list (seq-copy map) 222 :list (seq-copy map) ;FIXME: Probably not deep enough for alists!
190 :hash-table (copy-hash-table map) 223 :hash-table (copy-hash-table map)
191 :array (seq-copy map))) 224 :array (seq-copy map)))
192 225
@@ -337,9 +370,14 @@ MAP can be a list, hash-table or array."
337 "Convert the map MAP into a map of type TYPE.") 370 "Convert the map MAP into a map of type TYPE.")
338;; FIXME: I wish there was a way to avoid this η-redex! 371;; FIXME: I wish there was a way to avoid this η-redex!
339(cl-defmethod map-into (map (_type (eql list))) (map-pairs map)) 372(cl-defmethod map-into (map (_type (eql list))) (map-pairs map))
373(cl-defmethod map-into (map (_type (eql alist))) (map-pairs map))
374(cl-defmethod map-into (map (_type (eql plist)))
375 (let ((plist '()))
376 (map-do (lambda (k v) (setq plist `(,k ,v ,@plist))) map)
377 plist))
340 378
341(cl-defgeneric map-put! (map key value &optional testfn) 379(cl-defgeneric map-put! (map key value &optional testfn)
342 "Associate KEY with VALUE in MAP and return VALUE. 380 "Associate KEY with VALUE in MAP.
343If KEY is already present in MAP, replace the associated value 381If KEY is already present in MAP, replace the associated value
344with VALUE. 382with VALUE.
345This operates by modifying MAP in place. 383This operates by modifying MAP in place.
@@ -348,10 +386,13 @@ If you want to insert an element without modifying MAP, use `map-insert'."
348 ;; `testfn' only exists for backward compatibility with `map-put'! 386 ;; `testfn' only exists for backward compatibility with `map-put'!
349 (declare (advertised-calling-convention (map key value) "27.1")) 387 (declare (advertised-calling-convention (map key value) "27.1"))
350 (map--dispatch map 388 (map--dispatch map
351 :list (let ((oldmap map)) 389 :list
352 (setf (alist-get key map key nil (or testfn #'equal)) value) 390 (if (map--plist-p map)
353 (unless (eq oldmap map) 391 (plist-put map key value)
354 (signal 'map-not-inplace (list map)))) 392 (let ((oldmap map))
393 (setf (alist-get key map key nil (or testfn #'equal)) value)
394 (unless (eq oldmap map)
395 (signal 'map-not-inplace (list map)))))
355 :hash-table (puthash key value map) 396 :hash-table (puthash key value map)
356 ;; FIXME: If `key' is too large, should we signal `map-not-inplace' 397 ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
357 ;; and let `map-insert' grow the array? 398 ;; and let `map-insert' grow the array?
@@ -364,7 +405,9 @@ If you want to insert an element without modifying MAP, use `map-insert'."
364This does not modify MAP. 405This does not modify MAP.
365If you want to insert an element in place, use `map-put!'." 406If you want to insert an element in place, use `map-put!'."
366 (if (listp map) 407 (if (listp map)
367 (cons (cons key value) map) 408 (if (map--plist-p map)
409 `(,key ,value ,@map)
410 (cons (cons key value) map))
368 ;; FIXME: Should we signal an error or use copy+put! ? 411 ;; FIXME: Should we signal an error or use copy+put! ?
369 (signal 'map-inplace (list map)))) 412 (signal 'map-inplace (list map))))
370 413
@@ -374,11 +417,13 @@ If you want to insert an element in place, use `map-put!'."
374(define-obsolete-function-alias 'map--put #'map-put! "27.1") 417(define-obsolete-function-alias 'map--put #'map-put! "27.1")
375 418
376(cl-defmethod map-apply (function (map list)) 419(cl-defmethod map-apply (function (map list))
377 (seq-map (lambda (pair) 420 (if (map--plist-p map)
378 (funcall function 421 (cl-call-next-method)
379 (car pair) 422 (seq-map (lambda (pair)
380 (cdr pair))) 423 (funcall function
381 map)) 424 (car pair)
425 (cdr pair)))
426 map)))
382 427
383(cl-defmethod map-apply (function (map hash-table)) 428(cl-defmethod map-apply (function (map hash-table))
384 (let (result) 429 (let (result)
@@ -395,13 +440,16 @@ If you want to insert an element in place, use `map-put!'."
395 (setq index (1+ index)))) 440 (setq index (1+ index))))
396 map))) 441 map)))
397 442
398(cl-defmethod map-do (function (alist list)) 443(cl-defmethod map-do (function (map list))
399 "Private function used to iterate over ALIST using FUNCTION." 444 "Private function used to iterate over ALIST using FUNCTION."
400 (seq-do (lambda (pair) 445 (if (map--plist-p map)
401 (funcall function 446 (while map
402 (car pair) 447 (funcall function (pop map) (pop map)))
403 (cdr pair))) 448 (seq-do (lambda (pair)
404 alist)) 449 (funcall function
450 (car pair)
451 (cdr pair)))
452 map)))
405 453
406(cl-defmethod map-do (function (array array)) 454(cl-defmethod map-do (function (array array))
407 "Private function used to iterate over ARRAY using FUNCTION." 455 "Private function used to iterate over ARRAY using FUNCTION."
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
index 4dd67d48d40..9b8f17b7ca7 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -38,17 +38,19 @@ Evaluate BODY for each created map.
38\(fn (var map) body)" 38\(fn (var map) body)"
39 (declare (indent 1) (debug (symbolp body))) 39 (declare (indent 1) (debug (symbolp body)))
40 (let ((alist (make-symbol "alist")) 40 (let ((alist (make-symbol "alist"))
41 (plist (make-symbol "plist"))
41 (vec (make-symbol "vec")) 42 (vec (make-symbol "vec"))
42 (ht (make-symbol "ht"))) 43 (ht (make-symbol "ht")))
43 `(let ((,alist (list (cons 0 3) 44 `(let ((,alist (list (cons 0 3)
44 (cons 1 4) 45 (cons 1 4)
45 (cons 2 5))) 46 (cons 2 5)))
47 (,plist (list 0 3 1 4 2 5))
46 (,vec (vector 3 4 5)) 48 (,vec (vector 3 4 5))
47 (,ht (make-hash-table))) 49 (,ht (make-hash-table)))
48 (puthash 0 3 ,ht) 50 (puthash 0 3 ,ht)
49 (puthash 1 4 ,ht) 51 (puthash 1 4 ,ht)
50 (puthash 2 5 ,ht) 52 (puthash 2 5 ,ht)
51 (dolist (,var (list ,alist ,vec ,ht)) 53 (dolist (,var (list ,alist ,plist ,vec ,ht))
52 ,@body)))) 54 ,@body))))
53 55
54(ert-deftest test-map-elt () 56(ert-deftest test-map-elt ()
@@ -86,7 +88,8 @@ Evaluate BODY for each created map.
86 (with-maps-do map 88 (with-maps-do map
87 (map-put! map 2 'hello) 89 (map-put! map 2 'hello)
88 (should (eq (map-elt map 2) 'hello)) 90 (should (eq (map-elt map 2) 'hello))
89 (if (not (hash-table-p map)) 91 (if (not (or (hash-table-p map)
92 (and (listp map) (not (listp (car map)))))) ;plist!
90 (should-error (map-put! map 5 'value) 93 (should-error (map-put! map 5 'value)
91 ;; For vectors, it could arguably signal 94 ;; For vectors, it could arguably signal
92 ;; map-not-inplace as well, but it currently doesn't. 95 ;; map-not-inplace as well, but it currently doesn't.