map-put! and (setf (map-elt ...) ..) on lists

[Stefan Monnier <monnier@iro.umontreal.ca>]

The current handling of map-put on lists is very ad-hoc:
The gv-expander of `map-elt` tests if the arg is a list and if so
delegates to `alist-get`.

It kind of works, but for a library that's supposed to be generic and
expandable to other map types, this is undesirable.

So in the patch below I change this such that `map-elt` does not special
case lists any more.  Instead `map-put!` is changed to signal a special
error when it can't do its job, and the gv-expander of `map-elt` catches
this error and delegates the job to a new non-side-effecting
`map-insert`.

With this, we can add new map types via defmethod that work like lists
(i.e. that don't support inplace update but can still be modified via
`setf`).

WDYT?


        Stefan


diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 78cedd3ab1..d5051fcd98 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -95,12 +95,13 @@ map-let
            (t (error "Unsupported map type `%S': %S"
                      (type-of ,map-var) ,map-var)))))
 
+(define-error 'map-not-inplace "Cannot modify map in-place: %S")
+
 (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.
 
 TESTFN is deprecated.  Its default depends on the MAP argument.
-If MAP is a list, the default is `eql' to lookup KEY.
 
 In the base definition, MAP can be an alist, hash-table, or array."
   (declare
@@ -110,15 +111,16 @@ map-let
         (macroexp-let2* nil
             ;; Eval them once and for all in the right order.
             ((key key) (default default) (testfn testfn))
-          `(if (listp ,mgetter)
-               ;; Special case the alist case, since it can't be handled by the
-               ;; map--put function.
-               ,(gv-get `(alist-get ,key (gv-synthetic-place
-                                          ,mgetter ,msetter)
-                                    ,default nil ,testfn)
-                        do)
-             ,(funcall do `(map-elt ,mgetter ,key ,default)
-                       (lambda (v) `(map-put! ,mgetter ,key ,v)))))))))
+          (funcall do `(map-elt ,mgetter ,key ,default)
+                   (lambda (v)
+                     `(condition-case nil
+                          ;; Silence warnings about the hidden 4th arg.
+                          (with-no-warnings (map-put! ,mgetter ,key ,v ,testfn))
+                        (map-not-inplace
+                         ,(funcall msetter
+                                   `(map-insert ,mgetter ,key ,v))))))))))
+   ;; `testfn' is deprecated.
+   (advertised-calling-convention (map key &optional default) "27.1"))
   (map--dispatch map
     :list (alist-get key map default nil testfn)
     :hash-table (gethash key map default)
@@ -336,17 +338,36 @@ map-merge-with
 ;; FIXME: I wish there was a way to avoid this η-redex!
 (cl-defmethod map-into (map (_type (eql list))) (map-pairs map))
 
-(cl-defgeneric map-put! (map key value)
+(cl-defgeneric map-put! (map key value &optional testfn)
   "Associate KEY with VALUE in MAP and return VALUE.
 If KEY is already present in MAP, replace the associated value
-with VALUE."
+with VALUE.
+This operates by modifying MAP in place.
+If it cannot do that, it signals the `map-not-inplace' error.
+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 ((p (assoc key map)))
-            (if p (setcdr p value)
-              (error "No place to change the mapping for %S" key)))
+    :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))))
     :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?
     :array (aset map key value)))
 
+(define-error 'map-inplace "Can only modify map in place: %S")
+
+(cl-defgeneric map-insert (map key value)
+  "Return a new map like MAP except that it associates KEY with VALUE.
+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)
+    ;; FIXME: Should we signal an error or use copy+put! ?
+    (signal 'map-inplace (list map))))
+
 ;; There shouldn't be old source code referring to `map--put', yet we do
 ;; need to keep it for backward compatibility with .elc files where the
 ;; expansion of `setf' may call this function.
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
index 885b09be98..40ebb86e80 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -76,13 +76,25 @@ with-maps-do
                          'b
                          '2))))
 
-(ert-deftest test-map-put ()
+(ert-deftest test-map-put! ()
   (with-maps-do map
     (setf (map-elt map 2) 'hello)
     (should (eq (map-elt map 2) 'hello)))
   (with-maps-do map
     (map-put map 2 'hello)
     (should (eq (map-elt map 2) 'hello)))
+  (with-maps-do map
+    (map-put! map 2 'hello)
+    (should (eq (map-elt map 2) 'hello))
+    (if (not (hash-table-p map))
+        (should-error (map-put! map 5 'value)
+                      :type (if (listp map)
+                                'map-not-inplace
+                              ;; For vectors, it could arguably signal
+                              ;; map-not-inplace as well, but it currently doesn't.
+                              'error))
+      (map-put! map 5 'value)
+      (should (eq (map-elt map 5) 'value))))
   (let ((ht (make-hash-table)))
     (setf (map-elt ht 2) 'a)
     (should (eq (map-elt ht 2)
@@ -92,7 +104,7 @@ with-maps-do
     (should (eq (map-elt alist 2)
                 'a)))
   (let ((vec [3 4 5]))
-   (should-error (setf (map-elt vec 3) 6))))
+    (should-error (setf (map-elt vec 3) 6))))
 
 (ert-deftest test-map-put-alist-new-key ()
   "Regression test for Bug#23105."
@@ -105,9 +117,9 @@ with-maps-do
   (let ((alist (list (cons "a" 1) (cons "b" 2)))
         ;; Make sure to use a non-eq "a", even when compiled.
         (noneq-key (string ?a)))
-    (map-put alist noneq-key 3 'equal)
+    (map-put alist noneq-key 3 #'equal)
     (should-not (cddr alist))
-    (map-put alist noneq-key 9)
+    (map-put alist noneq-key 9 #'eql)
     (should (cddr alist))))
 
 (ert-deftest test-map-put-return-value ()