From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: map-put! and (setf (map-elt ...) ..) on lists Date: Fri, 14 Dec 2018 12:32:44 -0500 Message-ID: NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Trace: blaine.gmane.org 1544808740 26641 195.159.176.226 (14 Dec 2018 17:32:20 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 14 Dec 2018 17:32:20 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: emacs-devel@gnu.org To: Nicolas Petton Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Dec 14 18:32:16 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1gXrJv-0006nu-FL for ged-emacs-devel@m.gmane.org; Fri, 14 Dec 2018 18:32:15 +0100 Original-Received: from localhost ([::1]:34769 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gXrM2-000333-BE for ged-emacs-devel@m.gmane.org; Fri, 14 Dec 2018 12:34:26 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:41030) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gXrKV-0001MF-QY for emacs-devel@gnu.org; Fri, 14 Dec 2018 12:32:52 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gXrKR-000467-Ko for emacs-devel@gnu.org; Fri, 14 Dec 2018 12:32:51 -0500 Original-Received: from alt32.smtp-out.videotron.ca ([24.53.0.21]:59321) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1gXrKR-000458-E0 for emacs-devel@gnu.org; Fri, 14 Dec 2018 12:32:47 -0500 Original-Received: from fmsmemgm.homelinux.net ([23.233.195.134]) by Videotron with SMTP id XrKOgysqfwAkvXrKPg4ASA; Fri, 14 Dec 2018 12:32:45 -0500 X-Authority-Analysis: v=2.3 cv=e9Aot5h/ c=1 sm=1 tr=0 a=xXJ578j8WyTliCxld3/pTA==:117 a=xXJ578j8WyTliCxld3/pTA==:17 a=IkcTkHD0fZMA:10 a=2ur7OfE09M0A:10 a=jGfNP3m7_wUYc4HAE2EA:9 a=sfNHeeIrPzBeeK3T:21 a=QEXdDO2ut3YA:10 a=pHzHmUro8NiASowvMSCR:22 a=n87TN5wuljxrRezIQYnT:22 Original-Received: by fmsmemgm.homelinux.net (Postfix, from userid 20848) id 50C97AE97A; Fri, 14 Dec 2018 12:32:44 -0500 (EST) X-CMAE-Envelope: MS4wfIwNvZxYVrLAsaucv+5lzMtizJPqFDJ1PNjVtIY5sIKJ+E7AUMSV2cBrITcLV6Y4Al82tKUV5QLFkUYzHecVJOHP3VaSLDb2hh7RhMWxJ/MxjPd6HhIi CAU0QyUW1lYBljwrlT84R8owWC6hQUk/u+O6vsMXnF9vFNVOnH59/gm93GnCQ11tJMZsj7jU7Z9tuSRgOEtnn8qfJ0ylEskP//btd4HXRi31HM+wL9tik7p8 IMDyXFoOfhBoKvbbANDo5A== X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 24.53.0.21 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:231844 Archived-At: 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))))) =20 +(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. =20 TESTFN is deprecated. Its default depends on the MAP argument. -If MAP is a list, the default is `eql' to lookup KEY. =20 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 b= y 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 ,te= stfn)) + (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 =CE=B7-redex! (cl-defmethod map-into (map (_type (eql list))) (map-pairs map)) =20 -(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))) =20 +(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-t= ests.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)))) =20 -(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)))) =20 (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)))) =20 (ert-deftest test-map-put-return-value ()