mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/emacs-lisp/map.el: Make the functions generic

Browse source 
Make them document their delegation relationship, to clarify when
a method is needed.
(map--dispatch): Give more info in the error message.
(map-elt): Make it generic and deprecate the 'testfn' arg.
(map-put): Make it obsolete.
(map-length): Make it work on hash-tables.
(map-apply): Define it in terms of map-do.
(map-do, map-into): Use cl-generic dispatch instead of map--dispatch.
(map-empty-p): Define it in terms of map-length.
(map-contains-key): Deprecate 'testfn'.  Make it return a boolean, so
it can return non-nil even if 'key' is nil.  Improve implementation to
avoid constructing an intermediate list of all keys.
(map-merge-with): Use 'eql' rather than `eq'.
(map-put!): Rename from map--put and make it generic, to replace map-put.
(map--apply-alist, map--apply-hash-table, map--apply-array):
Turn them into methods of map-apply.
(map--do-alist, map--do-array): Turn them into methods of map-do.
(map--into-hash-table): Turn it into a method of map-into.
This commit is contained in:
Stefan Monnier 2018-12-11 17:54:13 -05:00
parent 1e34d7579c
commit 1691a51094
2 changed files with 111 additions and 101 deletions
Download patch file Download diff file Expand all files Collapse all files

6
etc/NEWS
View file

@ -304,6 +304,12 @@ the node "(emacs) Directory Variables" of the user manual.
* Changes in Specialized Modes and Packages in Emacs 27.1 * Changes in Specialized Modes and Packages in Emacs 27.1
** map.el
*** Now defined via generic functions that can be extended via cl-defmethod.
*** Deprecate the 'map-put' macro in favor of a new 'map-put!' function.
*** map-contains-key now returns a boolean rather than the key.
*** Deprecate the 'testfn' args of 'map-elt' and 'map-contains-key'.
--- ---
** Follow mode ** Follow mode
In the current follow group of windows, "ghost" cursors are no longer In the current follow group of windows, "ghost" cursors are no longer

206
lisp/emacs-lisp/map.el
View file

@ -92,17 +92,17 @@ Returns the result of evaluating the form associated with MAP-VAR's type."
`(cond ((listp ,map-var) ,(plist-get args :list)) `(cond ((listp ,map-var) ,(plist-get args :list))
((hash-table-p ,map-var) ,(plist-get args :hash-table)) ((hash-table-p ,map-var) ,(plist-get args :hash-table))
((arrayp ,map-var) ,(plist-get args :array)) ((arrayp ,map-var) ,(plist-get args :array))
(t (error "Unsupported map: %s" ,map-var))))) (t (error "Unsupported map type `%S': %S"
(type-of ,map-var) ,map-var)))))
(defun map-elt (map key &optional default testfn) (cl-defgeneric map-elt (map key &optional default testfn)
"Lookup KEY in MAP and return its associated value. "Lookup KEY in MAP and return its associated value.
If KEY is not found, return DEFAULT which defaults to nil. If KEY is not found, return DEFAULT which defaults to nil.
If MAP is a list, `eql' is used to lookup KEY. Optional argument TESTFN is deprecated. Its default depends on the MAP argument.
TESTFN, if non-nil, means use its function definition instead of If MAP is a list, the default is `eql' to lookup KEY.
`eql'.
MAP can be a list, hash-table or array." In the base definition, MAP can be an alist, hash-table, or array."
(declare (declare
(gv-expander (gv-expander
(lambda (do) (lambda (do)
@ -118,7 +118,7 @@ MAP can be a list, hash-table or array."
,default nil ,testfn) ,default nil ,testfn)
do) do)
,(funcall do `(map-elt ,mgetter ,key ,default) ,(funcall do `(map-elt ,mgetter ,key ,default)
(lambda (v) `(map--put ,mgetter ,key ,v))))))))) (lambda (v) `(map-put! ,mgetter ,key ,v)))))))))
(map--dispatch map (map--dispatch map
:list (alist-get key map default nil testfn) :list (alist-get key map default nil testfn)
:hash-table (gethash key map default) :hash-table (gethash key map default)
@ -133,9 +133,10 @@ with VALUE.
When MAP is a list, test equality with TESTFN if non-nil, otherwise use `eql'. When MAP is a list, test equality with TESTFN if non-nil, otherwise use `eql'.
MAP can be a list, hash-table or array." MAP can be a list, hash-table or array."
(declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1"))
`(setf (map-elt ,map ,key nil ,testfn) ,value)) `(setf (map-elt ,map ,key nil ,testfn) ,value))
(defun map-delete (map key) (cl-defgeneric map-delete (map key)
"Delete KEY from MAP and return MAP. "Delete KEY from MAP and return MAP.
No error is signaled if KEY is not a key of MAP. If MAP is an No error is signaled if KEY is not a key of MAP. If MAP is an
array, store nil at the index KEY. array, store nil at the index KEY.
@ -160,120 +161,121 @@ Map can be a nested map composed of alists, hash-tables and arrays."
map) map)
default)) default))
(defun map-keys (map) (cl-defgeneric map-keys (map)
"Return the list of keys in MAP. "Return the list of keys in MAP."
MAP can be a list, hash-table or array."
(map-apply (lambda (key _) key) map)) (map-apply (lambda (key _) key) map))
(defun map-values (map) (cl-defgeneric map-values (map)
"Return the list of values in MAP. "Return the list of values in MAP."
MAP can be a list, hash-table or array."
(map-apply (lambda (_ value) value) map)) (map-apply (lambda (_ value) value) map))
(defun map-pairs (map) (cl-defgeneric map-pairs (map)
"Return the elements of MAP as key/value association lists. "Return the elements of MAP as key/value association lists."
MAP can be a list, hash-table or array."
(map-apply #'cons map)) (map-apply #'cons map))
(defun map-length (map) (cl-defgeneric map-length (map)
"Return the length of MAP. ;; FIXME: Should we rename this to `map-size'?
"Return the number of elements in the map."
(cond
((hash-table-p map) (hash-table-count map))
((or (listp map) (arrayp map)) (length map))
(t (length (map-keys map)))))
MAP can be a list, hash-table or array." (cl-defgeneric map-copy (map)
(length (map-keys map))) "Return a copy of MAP."
(defun map-copy (map)
"Return a copy of MAP.
MAP can be a list, hash-table or array."
(map--dispatch map (map--dispatch map
:list (seq-copy map) :list (seq-copy map)
:hash-table (copy-hash-table map) :hash-table (copy-hash-table map)
:array (seq-copy map))) :array (seq-copy map)))
(defun map-apply (function map) (cl-defgeneric map-apply (function map)
"Apply FUNCTION to each element of MAP and return the result as a list. "Apply FUNCTION to each element of MAP and return the result as a list.
FUNCTION is called with two arguments, the key and the value. FUNCTION is called with two arguments, the key and the value.
The default implementation delegates to `map-do'."
(let ((res '()))
(map-do (lambda (k v) (push (funcall function k v) res)) map)
(nreverse res)))
MAP can be a list, hash-table or array." (cl-defgeneric map-do (function map)
(funcall (map--dispatch map
:list #'map--apply-alist
:hash-table #'map--apply-hash-table
:array #'map--apply-array)
function
map))
(defun map-do (function map)
"Apply FUNCTION to each element of MAP and return nil. "Apply FUNCTION to each element of MAP and return nil.
FUNCTION is called with two arguments, the key and the value." FUNCTION is called with two arguments, the key and the value.")
(funcall (map--dispatch map
:list #'map--do-alist
:hash-table #'maphash
:array #'map--do-array)
function
map))
(defun map-keys-apply (function map) ;; FIXME: I wish there was a way to avoid this η-redex!
(cl-defmethod map-do (function (map hash-table)) (maphash function map))
(cl-defgeneric map-keys-apply (function map)
"Return the result of applying FUNCTION to each key of MAP. "Return the result of applying FUNCTION to each key of MAP.
The default implementation delegates to `map-apply'."
MAP can be a list, hash-table or array."
(map-apply (lambda (key _) (map-apply (lambda (key _)
(funcall function key)) (funcall function key))
map)) map))
(defun map-values-apply (function map) (cl-defgeneric map-values-apply (function map)
"Return the result of applying FUNCTION to each value of MAP. "Return the result of applying FUNCTION to each value of MAP.
The default implementation delegates to `map-apply'."
MAP can be a list, hash-table or array."
(map-apply (lambda (_ val) (map-apply (lambda (_ val)
(funcall function val)) (funcall function val))
map)) map))
(defun map-filter (pred map) (cl-defgeneric map-filter (pred map)
"Return an alist of key/val pairs for which (PRED key val) is non-nil in MAP. "Return an alist of key/val pairs for which (PRED key val) is non-nil in MAP.
The default implementation delegates to `map-apply'."
MAP can be a list, hash-table or array."
(delq nil (map-apply (lambda (key val) (delq nil (map-apply (lambda (key val)
(if (funcall pred key val) (if (funcall pred key val)
(cons key val) (cons key val)
nil)) nil))
map))) map)))
(defun map-remove (pred map) (cl-defgeneric map-remove (pred map)
"Return an alist of the key/val pairs for which (PRED key val) is nil in MAP. "Return an alist of the key/val pairs for which (PRED key val) is nil in MAP.
The default implementation delegates to `map-filter'."
MAP can be a list, hash-table or array."
(map-filter (lambda (key val) (not (funcall pred key val))) (map-filter (lambda (key val) (not (funcall pred key val)))
map)) map))
(defun mapp (map) (cl-defgeneric mapp (map)
"Return non-nil if MAP is a map (list, hash-table or array)." "Return non-nil if MAP is a map (alist, hash-table, array, ...)."
(or (listp map) (or (listp map)
(hash-table-p map) (hash-table-p map)
(arrayp map))) (arrayp map)))
(defun map-empty-p (map) (cl-defgeneric map-empty-p (map)
"Return non-nil if MAP is empty. "Return non-nil if MAP is empty.
The default implementation delegates to `map-length'."
(zerop (map-length map)))
MAP can be a list, hash-table or array." (cl-defgeneric map-contains-key (map key &optional testfn)
(map--dispatch map ;; FIXME: The test function to use generally depends on the map object,
:list (null map) ;; so specifying `testfn' here is problematic: e.g. for hash-tables
:array (seq-empty-p map) ;; we shouldn't use `gethash' unless `testfn' is the same as the map's own
:hash-table (zerop (hash-table-count map)))) ;; test function!
"Return non-nil If and only if MAP contains KEY.
TESTFN is deprecated. Its default depends on MAP.
The default implementation delegates to `map-do'."
(unless testfn (setq testfn #'equal))
(catch 'map--catch
(map-do (lambda (k _v)
(if (funcall testfn key k) (throw 'map--catch t)))
map)
nil))
(defun map-contains-key (map key &optional testfn) (cl-defmethod map-contains-key ((map list) key &optional testfn)
"If MAP contain KEY return KEY, nil otherwise. (alist-get key map nil nil (or testfn #'equal)))
Equality is defined by TESTFN if non-nil or by `equal' if nil.
MAP can be a list, hash-table or array." (cl-defmethod map-contains-key ((map array) key &optional _testfn)
(seq-contains (map-keys map) key testfn)) (and (integerp key)
(>= key 0)
(< key (length map))))
(defun map-some (pred map) (cl-defmethod map-contains-key ((map hash-table) key &optional _testfn)
"Return a non-nil if (PRED key val) is non-nil for any key/value pair in MAP. (let ((v '(nil)))
(not (eq v (gethash key map v)))))
MAP can be a list, hash-table or array." (cl-defgeneric map-some (pred map)
"Return the first non-nil (PRED key val) in MAP.
The default implementation delegates to `map-apply'."
;; FIXME: Not sure if there's much benefit to defining it as defgeneric,
;; since as defined, I can't think of a map-type where we could provide an
;; algorithmically more efficient algorithm than the default.
(catch 'map--break (catch 'map--break
(map-apply (lambda (key value) (map-apply (lambda (key value)
(let ((result (funcall pred key value))) (let ((result (funcall pred key value)))
@ -282,10 +284,12 @@ MAP can be a list, hash-table or array."
map) map)
nil)) nil))
(defun map-every-p (pred map) (cl-defgeneric map-every-p (pred map)
"Return non-nil if (PRED key val) is non-nil for all elements of the map MAP. "Return non-nil if (PRED key val) is non-nil for all elements of the map MAP.
The default implementation delegates to `map-apply'."
MAP can be a list, hash-table or array." ;; FIXME: Not sure if there's much benefit to defining it as defgeneric,
;; since as defined, I can't think of a map-type where we could provide an
;; algorithmically more efficient algorithm than the default.
(catch 'map--break (catch 'map--break
(map-apply (lambda (key value) (map-apply (lambda (key value)
(or (funcall pred key value) (or (funcall pred key value)
@ -294,9 +298,7 @@ MAP can be a list, hash-table or array."
t)) t))
(defun map-merge (type &rest maps) (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."
MAP can be a list, hash-table or array."
(let ((result (map-into (pop maps) type))) (let ((result (map-into (pop maps) type)))
(while maps (while maps
;; FIXME: When `type' is `list', we get an O(N^2) behavior. ;; FIXME: When `type' is `list', we get an O(N^2) behavior.
@ -310,7 +312,7 @@ MAP can be a list, hash-table or array."
(defun map-merge-with (type function &rest maps) (defun map-merge-with (type function &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.
When two maps contain the same key, call FUNCTION on the two When two maps contain the same key (`eql'), call FUNCTION on the two
values and use the value returned by it. 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."
(let ((result (map-into (pop maps) type)) (let ((result (map-into (pop maps) type))
@ -318,24 +320,22 @@ MAP can be a list, hash-table or array."
(while maps (while maps
(map-apply (lambda (key value) (map-apply (lambda (key value)
(cl-callf (lambda (old) (cl-callf (lambda (old)
(if (eq old not-found) (if (eql old not-found)
value value
(funcall function old value))) (funcall function old value)))
(map-elt result key not-found))) (map-elt result key not-found)))
(pop maps))) (pop maps)))
result)) result))
(defun map-into (map type) (cl-defgeneric map-into (map type)
"Convert the map MAP into a map of type TYPE. "Convert the map MAP into a map of type TYPE.")
;; FIXME: I wish there was a way to avoid this η-redex!
(cl-defmethod map-into (map (_type (eql list))) (map-pairs map))
TYPE can be one of the following symbols: list or hash-table. (cl-defgeneric map-put! (map key v)
MAP can be a list, hash-table or array." "Associate KEY with VALUE in MAP and return VALUE.
(pcase type If KEY is already present in MAP, replace the associated value
('list (map-pairs map)) with VALUE."
('hash-table (map--into-hash-table map))
(_ (error "Not a map type name: %S" type))))
(defun map--put (map key v)
(map--dispatch map (map--dispatch map
:list (let ((p (assoc key map))) :list (let ((p (assoc key map)))
(if p (setcdr p v) (if p (setcdr p v)
@ -343,24 +343,26 @@ MAP can be a list, hash-table or array."
:hash-table (puthash key v map) :hash-table (puthash key v map)
:array (aset map key v))) :array (aset map key v)))
(defun map--apply-alist (function map) ;; There shouldn't be old source code referring to `map--put', yet we do
"Private function used to apply FUNCTION over MAP, MAP being an alist." ;; need to keep it for backward compatibility with .elc files where the
;; expansion of `setf' may call this function.
(define-obsolete-function-alias 'map--put #'map-put! "27.1")
(cl-defmethod map-apply (function (map list))
(seq-map (lambda (pair) (seq-map (lambda (pair)
(funcall function (funcall function
(car pair) (car pair)
(cdr pair))) (cdr pair)))
map)) map))
(defun map--apply-hash-table (function map) (cl-defmethod map-apply (function (map hash-table))
"Private function used to apply FUNCTION over MAP, MAP being a hash-table."
(let (result) (let (result)
(maphash (lambda (key value) (maphash (lambda (key value)
(push (funcall function key value) result)) (push (funcall function key value) result))
map) map)
(nreverse result))) (nreverse result)))
(defun map--apply-array (function map) (cl-defmethod map-apply (function (map array))
"Private function used to apply FUNCTION over MAP, MAP being an array."
(let ((index 0)) (let ((index 0))
(seq-map (lambda (elt) (seq-map (lambda (elt)
(prog1 (prog1
@ -368,7 +370,7 @@ MAP can be a list, hash-table or array."
(setq index (1+ index)))) (setq index (1+ index))))
map))) map)))
(defun map--do-alist (function alist) (cl-defmethod map-do (function (alist list))
"Private function used to iterate over ALIST using FUNCTION." "Private function used to iterate over ALIST using FUNCTION."
(seq-do (lambda (pair) (seq-do (lambda (pair)
(funcall function (funcall function
@ -376,14 +378,16 @@ MAP can be a list, hash-table or array."
(cdr pair))) (cdr pair)))
alist)) alist))
(defun map--do-array (function array) (cl-defmethod map-do (function (array array))
"Private function used to iterate over ARRAY using FUNCTION." "Private function used to iterate over ARRAY using FUNCTION."
(seq-do-indexed (lambda (elt index) (seq-do-indexed (lambda (elt index)
(funcall function index elt)) (funcall function index elt))
array)) array))
(defun map--into-hash-table (map) (cl-defmethod map-into (map (_type (eql hash-table)))
"Convert MAP into a 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) (let ((ht (make-hash-table :size (map-length map)
:test 'equal))) :test 'equal)))
(map-apply (lambda (key value) (map-apply (lambda (key value)