]> git.eshelyaron.com Git - emacs.git/commitdiff
* lisp/emacs-lisp/map.el: Add support for plists
authorStefan Monnier <monnier@iro.umontreal.ca>
Thu, 20 Dec 2018 13:40:43 +0000 (08:40 -0500)
committerStefan Monnier <monnier@iro.umontreal.ca>
Thu, 20 Dec 2018 13:40:43 +0000 (08:40 -0500)
(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.

etc/NEWS
lisp/emacs-lisp/map.el
test/lisp/emacs-lisp/map-tests.el

index bc76bec2d75d556f0de431c507cc96fc0b1816d1..7ff4aee64b5be2f5d0094e94860eb3e3b7a6b151 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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.
index d5051fcd98a29670d2b550d31eaabe463e66e160..53a1b3b171c5077a9e2f8028c301b38e772a3897 100644 (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."
index 4dd67d48d404d9bdb538bda5bf24baae6a70ee88..9b8f17b7ca727bd116e5cb10ca6c7c93bb7549b5 100644 (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.