diff options
| author | Stefan Monnier | 2018-12-20 08:40:43 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2018-12-20 08:40:43 -0500 |
| commit | f68f2eb47280cf92fdb41548e40b37e7a4a81e53 (patch) | |
| tree | 069f12113b34c54c7b81f4dd388740b3f18458b5 | |
| parent | 6a3c5f415b15531751dbbe4686950dbc15927866 (diff) | |
| download | emacs-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/NEWS | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/map.el | 108 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/map-tests.el | 7 |
3 files changed, 84 insertions, 32 deletions
| @@ -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. |
| 102 | If KEY is not found, return DEFAULT which defaults to nil. | 105 | 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 | ;; `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) |
| 143 | No error is signaled if KEY is not a key of MAP. If MAP is an | 151 | (while (consp tail) |
| 144 | array, 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 | ||
| 146 | MAP 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. | ||
| 167 | No error is signaled if KEY is not a key of MAP. | ||
| 168 | If 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. |
| 193 | The 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. |
| 198 | The 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. |
| 203 | The 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. |
| 209 | The 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. |
| 343 | If KEY is already present in MAP, replace the associated value | 381 | If KEY is already present in MAP, replace the associated value |
| 344 | with VALUE. | 382 | with VALUE. |
| 345 | This operates by modifying MAP in place. | 383 | 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 | ;; `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'." | |||
| 364 | This does not modify MAP. | 405 | This does not modify MAP. |
| 365 | If you want to insert an element in place, use `map-put!'." | 406 | If 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. |