From 1691a51094d35ac4b2c311fa407c6b77eea7a105 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 11 Dec 2018 17:54:13 -0500 Subject: [PATCH] * 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. --- etc/NEWS | 6 ++ lisp/emacs-lisp/map.el | 208 +++++++++++++++++++++-------------------- 2 files changed, 112 insertions(+), 102 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index e20fb14d3e4..0624c5690bc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 987521d9d85..35759db6270 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -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) -- 2.39.2