aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--etc/NEWS2
-rw-r--r--lisp/emacs-lisp/map.el31
-rw-r--r--test/lisp/emacs-lisp/map-tests.el5
3 files changed, 28 insertions, 10 deletions
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.
665*** New generic function 'map-insert'. 665*** New generic function 'map-insert'.
666 666
667+++ 667+++
668** The 'type' arg can be a list '(hash-table :key1 VAL1 :key2 VAL2 ...)'
669
668** seq.el 670** seq.el
669New convenience functions 'seq-first' and 'seq-rest' give easy access 671New convenience functions 'seq-first' and 'seq-rest' give easy access
670to respectively the first and all but the first elements of sequences. 672to 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'."
338 t)) 338 t))
339 339
340(defun map-merge (type &rest maps) 340(defun map-merge (type &rest maps)
341 "Merge into a map of type TYPE all the key/value pairs in MAPS." 341 "Merge into a map of type TYPE all the key/value pairs in MAPS.
342See `map-into' for all supported values of TYPE."
342 (let ((result (map-into (pop maps) type))) 343 (let ((result (map-into (pop maps) type)))
343 (while maps 344 (while maps
344 ;; FIXME: When `type' is `list', we get an O(N^2) behavior. 345 ;; FIXME: When `type' is `list', we get an O(N^2) behavior.
@@ -354,7 +355,8 @@ The default implementation delegates to `map-apply'."
354 "Merge into a map of type TYPE all the key/value pairs in MAPS. 355 "Merge into a map of type TYPE all the key/value pairs in MAPS.
355When two maps contain the same key (`eql'), call FUNCTION on the two 356When two maps contain the same key (`eql'), call FUNCTION on the two
356values and use the value returned by it. 357values and use the value returned by it.
357MAP can be a list, hash-table or array." 358MAP can be a list, hash-table or array.
359See `map-into' for all supported values of TYPE."
358 (let ((result (map-into (pop maps) type)) 360 (let ((result (map-into (pop maps) type))
359 (not-found (cons nil nil))) 361 (not-found (cons nil nil)))
360 (while maps 362 (while maps
@@ -458,17 +460,28 @@ If you want to insert an element in place, use `map-put!'."
458 (funcall function index elt)) 460 (funcall function index elt))
459 array)) 461 array))
460 462
461(cl-defmethod map-into (map (_type (eql hash-table))) 463(defun map--into-hash (map keyword-args)
462 "Convert MAP into a hash-table." 464 "Convert MAP into a hash-table.
463 ;; FIXME: Just knowing we want a hash-table is insufficient, since that 465KEYWORD-ARGS are forwarded to `make-hash-table'."
464 ;; doesn't tell us the test function to use with it! 466 (let ((ht (apply #'make-hash-table keyword-args)))
465 (let ((ht (make-hash-table :size (map-length map)
466 :test 'equal)))
467 (map-apply (lambda (key value) 467 (map-apply (lambda (key value)
468 (setf (map-elt ht key) value)) 468 (setf (gethash key ht) value))
469 map) 469 map)
470 ht)) 470 ht))
471 471
472(cl-defmethod map-into (map (_type (eql hash-table)))
473 "Convert MAP into a hash-table."
474 (map--into-hash map (list :size (map-length map) :test 'equal)))
475
476(cl-defmethod map-into (map (type (head hash-table)))
477 "Convert MAP into a hash-table.
478TYPE is a list where the car is `hash-table' and the cdr are the keyword-args
479forwarded to `make-hash-table'.
480
481Example:
482 (map-into '((1 . 3)) '(hash-table :test eql))"
483 (map--into-hash map (cdr type)))
484
472(defun map--make-pcase-bindings (args) 485(defun map--make-pcase-bindings (args)
473 "Return a list of pcase bindings from ARGS to the elements of a map." 486 "Return a list of pcase bindings from ARGS to the elements of a map."
474 (seq-map (lambda (elt) 487 (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.
340 340
341(ert-deftest test-map-into () 341(ert-deftest test-map-into ()
342 (let* ((alist '((a . 1) (b . 2))) 342 (let* ((alist '((a . 1) (b . 2)))
343 (ht (map-into alist 'hash-table))) 343 (ht (map-into alist 'hash-table))
344 (ht2 (map-into alist '(hash-table :test equal))))
344 (should (hash-table-p ht)) 345 (should (hash-table-p ht))
345 (should (equal (map-into (map-into alist 'hash-table) 'list) 346 (should (equal (map-into (map-into alist 'hash-table) 'list)
346 alist)) 347 alist))
@@ -349,6 +350,8 @@ Evaluate BODY for each created map.
349 (map-keys ht))) 350 (map-keys ht)))
350 (should (equal (map-values (map-into (map-into ht 'list) 'hash-table)) 351 (should (equal (map-values (map-into (map-into ht 'list) 'hash-table))
351 (map-values ht))) 352 (map-values ht)))
353 (should (equal (map-into ht 'alist) (map-into ht2 'alist)))
354 (should (eq (hash-table-test ht2) 'equal))
352 (should (null (map-into nil 'list))) 355 (should (null (map-into nil 'list)))
353 (should (map-empty-p (map-into nil 'hash-table))) 356 (should (map-empty-p (map-into nil 'hash-table)))
354 (should-error (map-into [1 2 3] 'string)))) 357 (should-error (map-into [1 2 3] 'string))))