Commit 1691a510 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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

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.
parent 1e34d757
Pipeline #262 failed with stage
in 5 minutes and 45 seconds
......@@ -304,6 +304,12 @@ the node "(emacs) Directory Variables" of the user manual.
* 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
In the current follow group of windows, "ghost" cursors are no longer
......
......@@ -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))
((hash-table-p ,map-var) ,(plist-get args :hash-table))
((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.
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, if non-nil, means use its function definition instead of
`eql'.
TESTFN is deprecated. Its default depends on the MAP argument.
If MAP is a list, the default is `eql' to lookup KEY.
MAP can be a list, hash-table or array."
In the base definition, MAP can be an alist, hash-table, or array."
(declare
(gv-expander
(lambda (do)
......@@ -118,7 +118,7 @@ MAP can be a list, hash-table or array."
,default nil ,testfn)
do)
,(funcall do `(map-elt ,mgetter ,key ,default)
(lambda (v) `(map--put ,mgetter ,key ,v)))))))))
(lambda (v) `(map-put! ,mgetter ,key ,v)))))))))
(map--dispatch map
:list (alist-get key map default nil testfn)
: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'.
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))
(defun map-delete (map key)
(cl-defgeneric map-delete (map key)
"Delete KEY from MAP and return MAP.
No error is signaled if KEY is not a key of MAP. If MAP is an
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)
default))
(defun map-keys (map)
"Return the list of keys in MAP.
MAP can be a list, hash-table or array."
(cl-defgeneric map-keys (map)
"Return the list of keys in MAP."
(map-apply (lambda (key _) key) map))
(defun map-values (map)
"Return the list of values in MAP.
MAP can be a list, hash-table or array."
(cl-defgeneric map-values (map)
"Return the list of values in MAP."
(map-apply (lambda (_ value) value) map))
(defun map-pairs (map)
"Return the elements of MAP as key/value association lists.
MAP can be a list, hash-table or array."
(cl-defgeneric map-pairs (map)
"Return the elements of MAP as key/value association lists."
(map-apply #'cons map))
(defun map-length (map)
"Return the length of MAP.
MAP can be a list, hash-table or array."
(length (map-keys map)))
(cl-defgeneric map-length (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)))))
(defun map-copy (map)
"Return a copy of MAP.
MAP can be a list, hash-table or array."
(cl-defgeneric map-copy (map)
"Return a copy of MAP."
(map--dispatch map
:list (seq-copy map)
:hash-table (copy-hash-table 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.
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."
(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)
(cl-defgeneric map-do (function map)
"Apply FUNCTION to each element of MAP and return nil.
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))
FUNCTION is called with two arguments, the key and the value.")
(defun map-keys-apply (function map)
"Return the result of applying FUNCTION to each key of MAP.
;; FIXME: I wish there was a way to avoid this η-redex!
(cl-defmethod map-do (function (map hash-table)) (maphash function map))
MAP can be a list, hash-table or array."
(cl-defgeneric map-keys-apply (function map)
"Return the result of applying FUNCTION to each key of MAP.
The default implementation delegates to `map-apply'."
(map-apply (lambda (key _)
(funcall function key))
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.
MAP can be a list, hash-table or array."
The default implementation delegates to `map-apply'."
(map-apply (lambda (_ val)
(funcall function val))
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.
MAP can be a list, hash-table or array."
The default implementation delegates to `map-apply'."
(delq nil (map-apply (lambda (key val)
(if (funcall pred key val)
(cons key val)
nil))
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.
MAP can be a list, hash-table or array."
The default implementation delegates to `map-filter'."
(map-filter (lambda (key val) (not (funcall pred key val)))
map))
(defun mapp (map)
"Return non-nil if MAP is a map (list, hash-table or array)."
(cl-defgeneric mapp (map)
"Return non-nil if MAP is a map (alist, hash-table, array, ...)."
(or (listp map)
(hash-table-p map)
(arrayp map)))
(defun map-empty-p (map)
(cl-defgeneric map-empty-p (map)
"Return non-nil if MAP is empty.
The default implementation delegates to `map-length'."
(zerop (map-length map)))
(cl-defgeneric map-contains-key (map key &optional testfn)
;; FIXME: The test function to use generally depends on the map object,
;; so specifying `testfn' here is problematic: e.g. for hash-tables
;; we shouldn't use `gethash' unless `testfn' is the same as the map's own
;; 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))
MAP can be a list, hash-table or array."
(map--dispatch map
:list (null map)
:array (seq-empty-p map)
:hash-table (zerop (hash-table-count map))))
(defun map-contains-key (map key &optional testfn)
"If MAP contain KEY return KEY, nil otherwise.
Equality is defined by TESTFN if non-nil or by `equal' if nil.
(cl-defmethod map-contains-key ((map list) key &optional testfn)
(alist-get key map nil nil (or testfn #'equal)))
MAP can be a list, hash-table or array."
(seq-contains (map-keys map) key testfn))
(cl-defmethod map-contains-key ((map array) key &optional _testfn)
(and (integerp key)
(>= key 0)
(< key (length map))))
(defun map-some (pred map)
"Return a non-nil if (PRED key val) is non-nil for any key/value pair in MAP.
(cl-defmethod map-contains-key ((map hash-table) key &optional _testfn)
(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
(map-apply (lambda (key value)
(let ((result (funcall pred key value)))
......@@ -282,10 +284,12 @@ MAP can be a list, hash-table or array."
map)
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.
MAP can be a list, hash-table or array."
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
(map-apply (lambda (key value)
(or (funcall pred key value)
......@@ -294,9 +298,7 @@ MAP can be a list, hash-table or array."
t))
(defun map-merge (type &rest maps)
"Merge into a map of type TYPE all the key/value pairs in MAPS.
MAP can be a list, hash-table or array."
"Merge into a map of type TYPE all the key/value pairs in MAPS."
(let ((result (map-into (pop maps) type)))
(while maps
;; 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)
"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.
MAP can be a list, hash-table or array."
(let ((result (map-into (pop maps) type))
......@@ -318,24 +320,22 @@ MAP can be a list, hash-table or array."
(while maps
(map-apply (lambda (key value)
(cl-callf (lambda (old)
(if (eq old not-found)
(if (eql old not-found)
value
(funcall function old value)))
(map-elt result key not-found)))
(pop maps)))
result))
(defun map-into (map type)
"Convert the map MAP into a map of type TYPE.
(cl-defgeneric map-into (map 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.
MAP can be a list, hash-table or array."
(pcase type
('list (map-pairs map))
('hash-table (map--into-hash-table map))
(_ (error "Not a map type name: %S" type))))
(defun map--put (map key v)
(cl-defgeneric map-put! (map key v)
"Associate KEY with VALUE in MAP and return VALUE.
If KEY is already present in MAP, replace the associated value
with VALUE."
(map--dispatch map
:list (let ((p (assoc key map)))
(if p (setcdr p v)
......@@ -343,24 +343,26 @@ MAP can be a list, hash-table or array."
:hash-table (puthash key v map)
:array (aset map key v)))
(defun map--apply-alist (function map)
"Private function used to apply FUNCTION over MAP, MAP being an alist."
;; There shouldn't be old source code referring to `map--put', yet we do
;; 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)
(funcall function
(car pair)
(cdr pair)))
map))
(defun map--apply-hash-table (function map)
"Private function used to apply FUNCTION over MAP, MAP being a hash-table."
(cl-defmethod map-apply (function (map hash-table))
(let (result)
(maphash (lambda (key value)
(push (funcall function key value) result))
map)
(nreverse result)))
(defun map--apply-array (function map)
"Private function used to apply FUNCTION over MAP, MAP being an array."
(cl-defmethod map-apply (function (map array))
(let ((index 0))
(seq-map (lambda (elt)
(prog1
......@@ -368,7 +370,7 @@ MAP can be a list, hash-table or array."
(setq index (1+ index))))
map)))
(defun map--do-alist (function alist)
(cl-defmethod map-do (function (alist list))
"Private function used to iterate over ALIST using FUNCTION."
(seq-do (lambda (pair)
(funcall function
......@@ -376,14 +378,16 @@ MAP can be a list, hash-table or array."
(cdr pair)))
alist))
(defun map--do-array (function array)
(cl-defmethod map-do (function (array array))
"Private function used to iterate over ARRAY using FUNCTION."
(seq-do-indexed (lambda (elt index)
(funcall function index elt))
array))
(defun map--into-hash-table (map)
(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)))
(map-apply (lambda (key value)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment