Re: [PATCH] extend map-into

[Andrea Corallo <akrl@sdf.org>]

[-- Attachment #1: Type: text/plain, Size: 321 bytes --]

Nicolas Petton <nico@petton.fr> writes:

> Andrea Corallo <akrl@sdf.org> writes:
>
>> Yes, feel free to come up with other suggestions on the patch or
>> upstream it if you like (I've no write access).
>
> Could you add tests to map-tests.el as well?
>
> Cheers,
> Nico

Sure,
attached.

Bests
  Andrea

-- 
akrl@sdf.org

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Extend-map-into-for-better-control-on-hash-table-cre.patch --]
[-- Type: text/x-patch, Size: 4304 bytes --]

From 7a1b42b1b58f7b0ee20ef24e9e73bce045a1987b Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Sun, 6 Oct 2019 22:43:11 +0200
Subject: [PATCH] Extend 'map-into' for better control on hash table creation.

---
 etc/NEWS                          |  4 ++++
 lisp/emacs-lisp/map.el            | 29 +++++++++++++++++++++--------
 test/lisp/emacs-lisp/map-tests.el |  5 ++++-
 3 files changed, 29 insertions(+), 9 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index c8cc753..5942a32 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -24,6 +24,10 @@ applies, and please also update docstrings as needed.
 \f
 * Installation Changes in Emacs 27.1
 
+** Extend function 'map-into'.
+Add a 'map-into' method to have hash table creation parameters
+tweak-able.
+
 ** Emacs now uses GMP, the GNU Multiple Precision library.
 By default, if 'configure' does not find a suitable libgmp, it
 arranges for the included mini-gmp library to be built and used.
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 54e802e..dfc1500 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -338,7 +338,8 @@ map-every-p
     t))
 
 (defun map-merge (type &rest maps)
-  "Merge into a map of type TYPE all the key/value pairs in MAPS."
+  "Merge into a map of type TYPE all the key/value pairs in MAPS.
+See `map-into' for all supported values of TYPE."
   (let ((result (map-into (pop maps) type)))
     (while maps
       ;; FIXME: When `type' is `list', we get an O(N^2) behavior.
@@ -354,7 +355,8 @@ map-merge-with
   "Merge into a map of type TYPE all the key/value pairs in MAPS.
 When two maps contain the same key (`eql'), call FUNCTION on the two
 values and use the value returned by it.
-MAP can be a list, hash-table or array."
+MAP can be a list, hash-table or array.
+See `map-into' for all supported values of TYPE."
   (let ((result (map-into (pop maps) type))
         (not-found (cons nil nil)))
     (while maps
@@ -458,17 +460,28 @@ map-do
                      (funcall function index elt))
                    array))
 
-(cl-defmethod map-into (map (_type (eql hash-table)))
-  "Convert MAP into a hash-table."
-  ;; FIXME: Just knowing we want a hash-table is insufficient, since that
-  ;; doesn't tell us the test function to use with it!
-  (let ((ht (make-hash-table :size (map-length map)
-                             :test 'equal)))
+(defsubst map--into-hash (map keyword-args)
+  "Convert MAP into a hash-table.
+KEYWORD-ARGS are forwarded to `make-hash-table'."
+  (let ((ht (apply #'make-hash-table keyword-args)))
     (map-apply (lambda (key value)
                  (setf (map-elt ht key) value))
                map)
     ht))
 
+(cl-defmethod map-into (map (_type (eql hash-table)))
+  "Convert MAP into a hash-table."
+  (map--into-hash map (list :size (map-length map) :test 'equal)))
+
+(cl-defmethod map-into (map (args (head hash-table)))
+  "Convert MAP into a hash-table.
+ARGS is a list where the car is 'hash-table' and the cdr are the keyword-args
+ forwarded to `make-hash-table'.
+
+Example:
+    (map-into '((1 . 3)) '(hash-table :test eql))"
+  (map--into-hash map (cdr args)))
+
 (defun map--make-pcase-bindings (args)
   "Return a list of pcase bindings from ARGS to the elements of a map."
   (seq-map (lambda (elt)
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
index a54af80..9f61511 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -340,7 +340,8 @@ test-map-every-p
 
 (ert-deftest test-map-into ()
   (let* ((alist '((a . 1) (b . 2)))
-         (ht (map-into alist 'hash-table)))
+         (ht (map-into alist 'hash-table))
+         (ht2 (map-into alist '(hash-table :test eq))))
     (should (hash-table-p ht))
     (should (equal (map-into (map-into alist 'hash-table) 'list)
                    alist))
@@ -349,6 +350,8 @@ test-map-into
                    (map-keys ht)))
     (should (equal (map-values (map-into (map-into ht 'list) 'hash-table))
                    (map-values ht)))
+    (should (equal (map-into ht 'alist) (map-into ht2 'alist)))
+    (should (eq (hash-table-test ht2) 'eq))
     (should (null (map-into nil 'list)))
     (should (map-empty-p (map-into nil 'hash-table)))
     (should-error (map-into [1 2 3] 'string))))
-- 
2.7.4