diff options
Diffstat (limited to 'lisp/emacs-lisp/map.el')
| -rw-r--r-- | lisp/emacs-lisp/map.el | 358 |
1 files changed, 218 insertions, 140 deletions
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 47de28f8f9e..54e802edf4f 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -4,7 +4,8 @@ ;; Author: Nicolas Petton <nicolas@petton.fr> ;; Keywords: convenience, map, hash-table, alist, array -;; Version: 1.2 +;; Version: 2.0 +;; Package-Requires: ((emacs "25")) ;; Package: map ;; Maintainer: emacs-devel@gnu.org @@ -92,17 +93,21 @@ 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) +(define-error 'map-not-inplace "Cannot modify map in-place") + +(defsubst map--plist-p (list) + (and (consp list) (not (listp (car list))))) + +(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. -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) @@ -110,17 +115,23 @@ MAP can be a list, hash-table or array." (macroexp-let2* nil ;; Eval them once and for all in the right order. ((key key) (default default) (testfn testfn)) - `(if (listp ,mgetter) - ;; Special case the alist case, since it can't be handled by the - ;; map--put function. - ,(gv-get `(alist-get ,key (gv-synthetic-place - ,mgetter ,msetter) - ,default nil ,testfn) - do) - ,(funcall do `(map-elt ,mgetter ,key ,default) - (lambda (v) `(map--put ,mgetter ,key ,v))))))))) + (funcall do `(map-elt ,mgetter ,key ,default) + (lambda (v) + `(condition-case nil + ;; Silence warnings about the hidden 4th arg. + (with-no-warnings (map-put! ,mgetter ,key ,v ,testfn)) + (map-not-inplace + ,(funcall msetter + `(map-insert ,mgetter ,key ,v)))))))))) + ;; `testfn' is deprecated. + (advertised-calling-convention (map key &optional default) "27.1")) (map--dispatch map - :list (alist-get key map default nil testfn) + :list (if (map--plist-p map) + (let ((res (plist-get map key))) + (if (and default (null res) (not (plist-member map key))) + default + res)) + (alist-get key map default nil testfn)) :hash-table (gethash key map default) :array (if (and (>= key 0) (< key (seq-length map))) (seq-elt map key) @@ -133,16 +144,34 @@ 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) - "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. - -MAP can be a list, hash-table or array." +(defun map--plist-delete (map key) + (let ((tail map) last) + (while (consp tail) + (cond + ((not (equal key (car tail))) + (setq last tail) + (setq tail (cddr last))) + (last + (setq tail (cddr tail)) + (setf (cddr last) tail)) + (t + (cl-assert (eq tail map)) + (setq map (cddr map)) + (setq tail map)))) + map)) + +(cl-defgeneric map-delete (map key) + "Delete KEY in-place 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." (map--dispatch map - :list (setf (alist-get key map nil t) nil) + ;; FIXME: Signal map-not-inplace i.s.o returning a different list? + :list (if (map--plist-p map) + (setq map (map--plist-delete map key)) + (setf (alist-get key map nil t) nil)) :hash-table (remhash key map) :array (and (>= key 0) (<= key (seq-length map)) @@ -160,120 +189,133 @@ Map can be a nested map composed of alists, hash-tables and arrays." map) default)) -(defun map-keys (map) +(cl-defgeneric map-keys (map) "Return the list of keys in MAP. - -MAP can be a list, hash-table or array." +The default implementation delegates to `map-apply'." (map-apply (lambda (key _) key) map)) -(defun map-values (map) +(cl-defgeneric map-values (map) "Return the list of values in MAP. - -MAP can be a list, hash-table or array." +The default implementation delegates to `map-apply'." (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. - -MAP can be a list, hash-table or array." +The default implementation delegates to `map-apply'." (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))) - -(defun map-copy (map) - "Return a copy of MAP. - -MAP can be a list, hash-table or array." +(cl-defgeneric map-length (map) + ;; FIXME: Should we rename this to `map-size'? + "Return the number of elements in the map. +The default implementation counts `map-keys'." + (cond + ((hash-table-p map) (hash-table-count map)) + ((listp map) + ;; FIXME: What about repeated/shadowed keys? + (if (map--plist-p map) (/ (length map) 2) (length map))) + ((arrayp map) (length map)) + (t (length (map-keys map))))) + +(cl-defgeneric map-copy (map) + "Return a copy of MAP." + ;; FIXME: Clarify how deep is the copy! (map--dispatch map - :list (seq-copy map) + :list (seq-copy map) ;FIXME: Probably not deep enough for alists! :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)) - -(defun map-keys-apply (function map) - "Return the result of applying FUNCTION to each key of MAP. +FUNCTION is called with two arguments, the key and the value.") -MAP can be a list, hash-table or array." +;; 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. +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-defmethod map-empty-p ((map list)) + (null 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. - -MAP can be a list, hash-table or array." - (seq-contains (map-keys map) key testfn)) - -(defun map-some (pred map) - "Return a non-nil if (PRED key val) is non-nil for any key/value pair in MAP. - -MAP can be a list, hash-table or array." +(cl-defmethod map-contains-key ((map list) key &optional testfn) + (let ((v '(nil))) + (not (eq v (alist-get key map v nil (or testfn #'equal)))))) + +(cl-defmethod map-contains-key ((map array) key &optional _testfn) + (and (integerp key) + (>= key 0) + (< key (length map)))) + +(cl-defmethod map-contains-key ((map hash-table) key &optional _testfn) + (let ((v '(nil))) + (not (eq v (gethash key map v))))) + +(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 +324,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 +338,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 +352,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,49 +360,80 @@ 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. - -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-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)) +(cl-defmethod map-into (map (_type (eql alist))) (map-pairs map)) +(cl-defmethod map-into (map (_type (eql plist))) + (let ((plist '())) + (map-do (lambda (k v) (setq plist `(,k ,v ,@plist))) map) + plist)) + +(cl-defgeneric map-put! (map key value &optional testfn) + "Associate KEY with VALUE in MAP. +If KEY is already present in MAP, replace the associated value +with VALUE. +This operates by modifying MAP in place. +If it cannot do that, it signals the `map-not-inplace' error. +If you want to insert an element without modifying MAP, use `map-insert'." + ;; `testfn' only exists for backward compatibility with `map-put'! + (declare (advertised-calling-convention (map key value) "27.1")) (map--dispatch map - :list (let ((p (assoc key map))) - (if p (setcdr p v) - (error "No place to change the mapping for %S" key))) - :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." - (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." + :list + (if (map--plist-p map) + (plist-put map key value) + (let ((oldmap map)) + (setf (alist-get key map key nil (or testfn #'equal)) value) + (unless (eq oldmap map) + (signal 'map-not-inplace (list oldmap))))) + :hash-table (puthash key value map) + ;; FIXME: If `key' is too large, should we signal `map-not-inplace' + ;; and let `map-insert' grow the array? + :array (aset map key value))) + +(define-error 'map-inplace "Can only modify map in place") + +(cl-defgeneric map-insert (map key value) + "Return a new map like MAP except that it associates KEY with VALUE. +This does not modify MAP. +If you want to insert an element in place, use `map-put!'." + (if (listp map) + (if (map--plist-p map) + `(,key ,value ,@map) + (cons (cons key value) map)) + ;; FIXME: Should we signal an error or use copy+put! ? + (signal 'map-inplace (list map)))) + +;; 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)) + (if (map--plist-p map) + (cl-call-next-method) + (seq-map (lambda (pair) + (funcall function + (car pair) + (cdr pair))) + map))) + +(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,22 +441,27 @@ 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 (map list)) "Private function used to iterate over ALIST using FUNCTION." - (seq-do (lambda (pair) - (funcall function - (car pair) - (cdr pair))) - alist)) - -(defun map--do-array (function array) + (if (map--plist-p map) + (while map + (funcall function (pop map) (pop map))) + (seq-do (lambda (pair) + (funcall function + (car pair) + (cdr pair))) + map))) + +(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) |