diff options
| author | Artur Malabarba <bruce.connor.am@gmail.com> | 2015-11-07 12:45:18 +0000 |
|---|---|---|
| committer | Artur Malabarba <bruce.connor.am@gmail.com> | 2015-11-10 13:04:30 +0000 |
| commit | cbaa04014e0c9efdfc6393bccde0e6579b5d7051 (patch) | |
| tree | a0fc99cbe4225fc9ff5b5ed04fd5f07441e9cbc8 | |
| parent | cbc51211f9e4f8f3d4b8a1feaa6cbfd2fd4ac1ca (diff) | |
| download | emacs-cbaa04014e0c9efdfc6393bccde0e6579b5d7051.tar.gz | |
* lisp/emacs-lisp/map.el (map-merge-with): New function
* test/automated/map-tests.el (test-map-merge-with): New test
| -rw-r--r-- | lisp/emacs-lisp/map.el | 25 | ||||
| -rw-r--r-- | test/automated/map-tests.el | 7 |
2 files changed, 27 insertions, 5 deletions
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 5ef51f12d96..7ff9031b08d 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -279,9 +279,9 @@ MAP can be a list, hash-table or array." MAP can be a list, hash-table or array." (catch 'map--break (map-apply (lambda (key value) - (or (funcall pred key value) - (throw 'map--break nil))) - map) + (or (funcall pred key value) + (throw 'map--break nil))) + map) t)) (defun map-merge (type &rest maps) @@ -291,8 +291,23 @@ MAP can be a list, hash-table or array." (let (result) (while maps (map-apply (lambda (key value) - (setf (map-elt result key) value)) - (pop maps))) + (setf (map-elt result key) value)) + (pop maps))) + (map-into result type))) + +(defun map-merge-with (type function &rest maps) + "Merge into a map of type TYPE all the key/value pairs in MAPS. +When two maps contain the same key, call FUNCTION on the two +values and use the value returned by it. +MAP can be a list, hash-table or array." + (let (result) + (while maps + (map-apply (lambda (key value) + (setf (map-elt result key) + (if (map-contains-key result key) + (funcall function (map-elt result key) value) + value))) + (pop maps))) (map-into result type))) (defun map-into (map type) diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el index 8693415a784..1a759b523a5 100644 --- a/test/automated/map-tests.el +++ b/test/automated/map-tests.el @@ -320,5 +320,12 @@ Evaluate BODY for each created map. (should (= b 2)) (should (null c)))) +(ert-deftest test-map-merge-with () + (should (equal (map-merge-with 'list #'+ + '((1 . 2)) + '((1 . 3) (2 . 4)) + '((1 . 1) (2 . 5) (3 . 0))) + '((3 . 0) (2 . 9) (1 . 6))))) + (provide 'map-tests) ;;; map-tests.el ends here |