diff --git a/etc/NEWS b/etc/NEWS index 4e7843ced85..2fe0a907ef4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -665,6 +665,8 @@ at the end of the active minibuffer. *** New generic function 'map-insert'. +++ +** The 'type' arg can be a list '(hash-table :key1 VAL1 :key2 VAL2 ...)' + ** seq.el New convenience functions 'seq-first' and 'seq-rest' give easy access to respectively the first and all but the first elements of sequences. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 54e802edf4f..74927b6224f 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -338,7 +338,8 @@ The default implementation delegates to `map-apply'." 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 @@ The default implementation delegates to `map-apply'." "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 @@ If you want to insert an element in place, use `map-put!'." (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))) +(defun 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)) + (setf (gethash key ht) 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 (type (head hash-table))) + "Convert MAP into a hash-table. +TYPE 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 type))) + (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 a54af8059b3..5e8c9cb9f07 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -340,7 +340,8 @@ Evaluate BODY for each created map. (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 equal)))) (should (hash-table-p ht)) (should (equal (map-into (map-into alist 'hash-table) 'list) alist)) @@ -349,6 +350,8 @@ Evaluate BODY for each created map. (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) 'equal)) (should (null (map-into nil 'list))) (should (map-empty-p (map-into nil 'hash-table))) (should-error (map-into [1 2 3] 'string))))