LCOV - code coverage report
Current view: top level - lisp/emacs-lisp - map.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 146 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 54 0.0 %

          Line data    Source code
       1             : ;;; map.el --- Map manipulation functions  -*- lexical-binding: t; -*-
       2             : 
       3             : ;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Nicolas Petton <nicolas@petton.fr>
       6             : ;; Keywords: convenience, map, hash-table, alist, array
       7             : ;; Version: 1.2
       8             : ;; Package: map
       9             : 
      10             : ;; Maintainer: emacs-devel@gnu.org
      11             : 
      12             : ;; This file is part of GNU Emacs.
      13             : 
      14             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      15             : ;; it under the terms of the GNU General Public License as published by
      16             : ;; the Free Software Foundation, either version 3 of the License, or
      17             : ;; (at your option) any later version.
      18             : 
      19             : ;; GNU Emacs is distributed in the hope that it will be useful,
      20             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      21             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      22             : ;; GNU General Public License for more details.
      23             : 
      24             : ;; You should have received a copy of the GNU General Public License
      25             : ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
      26             : 
      27             : ;;; Commentary:
      28             : 
      29             : ;; map.el provides map-manipulation functions that work on alists,
      30             : ;; hash-table and arrays.  All functions are prefixed with "map-".
      31             : ;;
      32             : ;; Functions taking a predicate or iterating over a map using a
      33             : ;; function take the function as their first argument.  All other
      34             : ;; functions take the map as their first argument.
      35             : 
      36             : ;; TODO:
      37             : ;; - Add support for char-tables
      38             : ;; - Maybe add support for gv?
      39             : ;; - See if we can integrate text-properties
      40             : ;; - A macro similar to let-alist but working on any type of map could
      41             : ;;   be really useful
      42             : 
      43             : ;;; Code:
      44             : 
      45             : (require 'seq)
      46             : (eval-when-compile (require 'cl-lib))
      47             : 
      48             : (pcase-defmacro map (&rest args)
      49             :   "Build a `pcase' pattern matching map elements.
      50             : 
      51             : ARGS is a list of elements to be matched in the map.
      52             : 
      53             : Each element of ARGS can be of the form (KEY PAT), in which case KEY is
      54             : evaluated and searched for in the map.  The match fails if for any KEY
      55             : found in the map, the corresponding PAT doesn't match the value
      56             : associated to the KEY.
      57             : 
      58             : Each element can also be a SYMBOL, which is an abbreviation of a (KEY
      59             : PAT) tuple of the form (\\='SYMBOL SYMBOL).
      60             : 
      61             : Keys in ARGS not found in the map are ignored, and the match doesn't
      62             : fail."
      63           0 :   `(and (pred mapp)
      64           0 :         ,@(map--make-pcase-bindings args)))
      65             : 
      66             : (defmacro map-let (keys map &rest body)
      67             :   "Bind the variables in KEYS to the elements of MAP then evaluate BODY.
      68             : 
      69             : KEYS can be a list of symbols, in which case each element will be
      70             : bound to the looked up value in MAP.
      71             : 
      72             : KEYS can also be a list of (KEY VARNAME) pairs, in which case
      73             : KEY is an unquoted form.
      74             : 
      75             : MAP can be a list, hash-table or array."
      76             :   (declare (indent 2) (debug t))
      77           0 :   `(pcase-let ((,(map--make-pcase-patterns keys) ,map))
      78           0 :      ,@body))
      79             : 
      80             : (eval-when-compile
      81             :   (defmacro map--dispatch (map-var &rest args)
      82             :     "Evaluate one of the forms specified by ARGS based on the type of MAP-VAR.
      83             : 
      84             : The following keyword types are meaningful: `:list',
      85             : `:hash-table' and `:array'.
      86             : 
      87             : An error is thrown if MAP-VAR is neither a list, hash-table nor array.
      88             : 
      89             : Returns the result of evaluating the form associated with MAP-VAR's type."
      90             :     (declare (debug t) (indent 1))
      91             :     `(cond ((listp ,map-var) ,(plist-get args :list))
      92             :            ((hash-table-p ,map-var) ,(plist-get args :hash-table))
      93             :            ((arrayp ,map-var) ,(plist-get args :array))
      94             :            (t (error "Unsupported map: %s" ,map-var)))))
      95             : 
      96             : (defun map-elt (map key &optional default testfn)
      97             :   "Lookup KEY in MAP and return its associated value.
      98             : If KEY is not found, return DEFAULT which defaults to nil.
      99             : 
     100             : If MAP is a list, `eql' is used to lookup KEY.  Optional argument
     101             : TESTFN, if non-nil, means use its function definition instead of
     102             : `eql'.
     103             : 
     104             : MAP can be a list, hash-table or array."
     105             :   (declare
     106             :    (gv-expander
     107             :     (lambda (do)
     108             :       (gv-letplace (mgetter msetter) `(gv-delay-error ,map)
     109             :         (macroexp-let2* nil
     110             :             ;; Eval them once and for all in the right order.
     111             :             ((key key) (default default) (testfn testfn))
     112             :           `(if (listp ,mgetter)
     113             :                ;; Special case the alist case, since it can't be handled by the
     114             :                ;; map--put function.
     115             :                ,(gv-get `(alist-get ,key (gv-synthetic-place
     116             :                                           ,mgetter ,msetter)
     117             :                                     ,default nil ,testfn)
     118             :                         do)
     119             :              ,(funcall do `(map-elt ,mgetter ,key ,default)
     120             :                        (lambda (v) `(map--put ,mgetter ,key ,v)))))))))
     121           0 :   (map--dispatch map
     122           0 :     :list (alist-get key map default nil testfn)
     123           0 :     :hash-table (gethash key map default)
     124           0 :     :array (if (and (>= key 0) (< key (seq-length map)))
     125           0 :                (seq-elt map key)
     126           0 :              default)))
     127             : 
     128             : (defmacro map-put (map key value &optional testfn)
     129             :   "Associate KEY with VALUE in MAP and return VALUE.
     130             : If KEY is already present in MAP, replace the associated value
     131             : with VALUE.
     132             : When MAP is a list, test equality with TESTFN if non-nil, otherwise use `eql'.
     133             : 
     134             : MAP can be a list, hash-table or array."
     135           0 :   `(setf (map-elt ,map ,key nil ,testfn) ,value))
     136             : 
     137             : (defun map-delete (map key)
     138             :   "Delete KEY from MAP and return MAP.
     139             : No error is signaled if KEY is not a key of MAP.  If MAP is an
     140             : array, store nil at the index KEY.
     141             : 
     142             : MAP can be a list, hash-table or array."
     143           0 :   (map--dispatch map
     144           0 :     :list (setf (alist-get key map nil t) nil)
     145           0 :     :hash-table (remhash key map)
     146           0 :     :array (and (>= key 0)
     147           0 :                 (<= key (seq-length map))
     148           0 :                 (aset map key nil)))
     149           0 :   map)
     150             : 
     151             : (defun map-nested-elt (map keys &optional default)
     152             :   "Traverse MAP using KEYS and return the looked up value or DEFAULT if nil.
     153             : 
     154             : Map can be a nested map composed of alists, hash-tables and arrays."
     155           0 :   (or (seq-reduce (lambda (acc key)
     156           0 :                     (when (mapp acc)
     157           0 :                       (map-elt acc key)))
     158           0 :                   keys
     159           0 :                   map)
     160           0 :       default))
     161             : 
     162             : (defun map-keys (map)
     163             :   "Return the list of keys in MAP.
     164             : 
     165             : MAP can be a list, hash-table or array."
     166           0 :   (map-apply (lambda (key _) key) map))
     167             : 
     168             : (defun map-values (map)
     169             :   "Return the list of values in MAP.
     170             : 
     171             : MAP can be a list, hash-table or array."
     172           0 :   (map-apply (lambda (_ value) value) map))
     173             : 
     174             : (defun map-pairs (map)
     175             :   "Return the elements of MAP as key/value association lists.
     176             : 
     177             : MAP can be a list, hash-table or array."
     178           0 :   (map-apply #'cons map))
     179             : 
     180             : (defun map-length (map)
     181             :   "Return the length of MAP.
     182             : 
     183             : MAP can be a list, hash-table or array."
     184           0 :   (length (map-keys map)))
     185             : 
     186             : (defun map-copy (map)
     187             :   "Return a copy of MAP.
     188             : 
     189             : MAP can be a list, hash-table or array."
     190           0 :   (map--dispatch map
     191           0 :     :list (seq-copy map)
     192           0 :     :hash-table (copy-hash-table map)
     193           0 :     :array (seq-copy map)))
     194             : 
     195             : (defun map-apply (function map)
     196             :   "Apply FUNCTION to each element of MAP and return the result as a list.
     197             : FUNCTION is called with two arguments, the key and the value.
     198             : 
     199             : MAP can be a list, hash-table or array."
     200           0 :   (funcall (map--dispatch map
     201           0 :              :list #'map--apply-alist
     202           0 :              :hash-table #'map--apply-hash-table
     203           0 :              :array #'map--apply-array)
     204           0 :            function
     205           0 :            map))
     206             : 
     207             : (defun map-do (function map)
     208             :   "Apply FUNCTION to each element of MAP and return nil.
     209             : FUNCTION.is called with two arguments, the key and the value."
     210           0 :   (funcall (map--dispatch map
     211           0 :              :list #'map--do-alist
     212           0 :              :hash-table #'maphash
     213           0 :              :array #'map--do-array)
     214           0 :            function
     215           0 :            map))
     216             : 
     217             : (defun map-keys-apply (function map)
     218             :   "Return the result of applying FUNCTION to each key of MAP.
     219             : 
     220             : MAP can be a list, hash-table or array."
     221           0 :   (map-apply (lambda (key _)
     222           0 :                (funcall function key))
     223           0 :              map))
     224             : 
     225             : (defun map-values-apply (function map)
     226             :   "Return the result of applying FUNCTION to each value of MAP.
     227             : 
     228             : MAP can be a list, hash-table or array."
     229           0 :   (map-apply (lambda (_ val)
     230           0 :                (funcall function val))
     231           0 :              map))
     232             : 
     233             : (defun map-filter (pred map)
     234             :   "Return an alist of key/val pairs for which (PRED key val) is non-nil in MAP.
     235             : 
     236             : MAP can be a list, hash-table or array."
     237           0 :   (delq nil (map-apply (lambda (key val)
     238           0 :                          (if (funcall pred key val)
     239           0 :                              (cons key val)
     240           0 :                            nil))
     241           0 :                        map)))
     242             : 
     243             : (defun map-remove (pred map)
     244             :   "Return an alist of the key/val pairs for which (PRED key val) is nil in MAP.
     245             : 
     246             : MAP can be a list, hash-table or array."
     247           0 :   (map-filter (lambda (key val) (not (funcall pred key val)))
     248           0 :               map))
     249             : 
     250             : (defun mapp (map)
     251             :   "Return non-nil if MAP is a map (list, hash-table or array)."
     252           0 :   (or (listp map)
     253           0 :       (hash-table-p map)
     254           0 :       (arrayp map)))
     255             : 
     256             : (defun map-empty-p (map)
     257             :   "Return non-nil if MAP is empty.
     258             : 
     259             : MAP can be a list, hash-table or array."
     260           0 :   (map--dispatch map
     261           0 :     :list (null map)
     262           0 :     :array (seq-empty-p map)
     263           0 :     :hash-table (zerop (hash-table-count map))))
     264             : 
     265             : (defun map-contains-key (map key &optional testfn)
     266             :   "If MAP contain KEY return KEY, nil otherwise.
     267             : Equality is defined by TESTFN if non-nil or by `equal' if nil.
     268             : 
     269             : MAP can be a list, hash-table or array."
     270           0 :   (seq-contains (map-keys map) key testfn))
     271             : 
     272             : (defun map-some (pred map)
     273             :   "Return a non-nil if (PRED key val) is non-nil for any key/value pair in MAP.
     274             : 
     275             : MAP can be a list, hash-table or array."
     276           0 :   (catch 'map--break
     277           0 :     (map-apply (lambda (key value)
     278           0 :                  (let ((result (funcall pred key value)))
     279           0 :                    (when result
     280           0 :                      (throw 'map--break result))))
     281           0 :                map)
     282           0 :     nil))
     283             : 
     284             : (defun map-every-p (pred map)
     285             :   "Return non-nil if (PRED key val) is non-nil for all elements of the map MAP.
     286             : 
     287             : MAP can be a list, hash-table or array."
     288           0 :   (catch 'map--break
     289           0 :     (map-apply (lambda (key value)
     290           0 :               (or (funcall pred key value)
     291           0 :                   (throw 'map--break nil)))
     292           0 :             map)
     293           0 :     t))
     294             : 
     295             : (defun map-merge (type &rest maps)
     296             :   "Merge into a map of type TYPE all the key/value pairs in MAPS.
     297             : 
     298             : MAP can be a list, hash-table or array."
     299           0 :   (let ((result (map-into (pop maps) type)))
     300           0 :     (while maps
     301             :       ;; FIXME: When `type' is `list', we get an O(N^2) behavior.
     302             :       ;; For small tables, this is fine, but for large tables, we
     303             :       ;; should probably use a hash-table internally which we convert
     304             :       ;; to an alist in the end.
     305           0 :       (map-apply (lambda (key value)
     306           0 :                    (setf (map-elt result key) value))
     307           0 :                  (pop maps)))
     308           0 :     result))
     309             : 
     310             : (defun map-merge-with (type function &rest maps)
     311             :   "Merge into a map of type TYPE all the key/value pairs in MAPS.
     312             : When two maps contain the same key, call FUNCTION on the two
     313             : values and use the value returned by it.
     314             : MAP can be a list, hash-table or array."
     315           0 :   (let ((result (map-into (pop maps) type))
     316           0 :         (not-found (cons nil nil)))
     317           0 :     (while maps
     318           0 :       (map-apply (lambda (key value)
     319           0 :                    (cl-callf (lambda (old)
     320           0 :                                (if (eq old not-found)
     321           0 :                                    value
     322           0 :                                  (funcall function old value)))
     323           0 :                        (map-elt result key not-found)))
     324           0 :                  (pop maps)))
     325           0 :     result))
     326             : 
     327             : (defun map-into (map type)
     328             :   "Convert the map MAP into a map of type TYPE.
     329             : 
     330             : TYPE can be one of the following symbols: list or hash-table.
     331             : MAP can be a list, hash-table or array."
     332           0 :   (pcase type
     333           0 :     (`list (map-pairs map))
     334           0 :     (`hash-table (map--into-hash-table map))
     335           0 :     (_ (error "Not a map type name: %S" type))))
     336             : 
     337             : (defun map--put (map key v)
     338           0 :   (map--dispatch map
     339           0 :     :list (let ((p (assoc key map)))
     340           0 :             (if p (setcdr p v)
     341           0 :               (error "No place to change the mapping for %S" key)))
     342           0 :     :hash-table (puthash key v map)
     343           0 :     :array (aset map key v)))
     344             : 
     345             : (defun map--apply-alist (function map)
     346             :   "Private function used to apply FUNCTION over MAP, MAP being an alist."
     347           0 :   (seq-map (lambda (pair)
     348           0 :              (funcall function
     349           0 :                       (car pair)
     350           0 :                       (cdr pair)))
     351           0 :            map))
     352             : 
     353             : (defun map--apply-hash-table (function map)
     354             :   "Private function used to apply FUNCTION over MAP, MAP being a hash-table."
     355           0 :   (let (result)
     356           0 :     (maphash (lambda (key value)
     357           0 :                (push (funcall function key value) result))
     358           0 :              map)
     359           0 :     (nreverse result)))
     360             : 
     361             : (defun map--apply-array (function map)
     362             :   "Private function used to apply FUNCTION over MAP, MAP being an array."
     363           0 :   (let ((index 0))
     364           0 :     (seq-map (lambda (elt)
     365           0 :                (prog1
     366           0 :                    (funcall function index elt)
     367           0 :                  (setq index (1+ index))))
     368           0 :              map)))
     369             : 
     370             : (defun map--do-alist (function alist)
     371             :   "Private function used to iterate over ALIST using FUNCTION."
     372           0 :   (seq-do (lambda (pair)
     373           0 :             (funcall function
     374           0 :                      (car pair)
     375           0 :                      (cdr pair)))
     376           0 :           alist))
     377             : 
     378             : (defun map--do-array (function array)
     379             :   "Private function used to iterate over ARRAY using FUNCTION."
     380           0 :   (seq-do-indexed (lambda (elt index)
     381           0 :                      (funcall function index elt))
     382           0 :                    array))
     383             : 
     384             : (defun map--into-hash-table (map)
     385             :   "Convert MAP into a hash-table."
     386           0 :   (let ((ht (make-hash-table :size (map-length map)
     387           0 :                              :test 'equal)))
     388           0 :     (map-apply (lambda (key value)
     389           0 :                  (setf (map-elt ht key) value))
     390           0 :                map)
     391           0 :     ht))
     392             : 
     393             : (defun map--make-pcase-bindings (args)
     394             :   "Return a list of pcase bindings from ARGS to the elements of a map."
     395           0 :   (seq-map (lambda (elt)
     396           0 :              (if (consp elt)
     397           0 :                  `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt))
     398           0 :                `(app (pcase--flip map-elt ',elt) ,elt)))
     399           0 :            args))
     400             : 
     401             : (defun map--make-pcase-patterns (args)
     402             :   "Return a list of `(map ...)' pcase patterns built from ARGS."
     403           0 :   (cons 'map
     404           0 :         (seq-map (lambda (elt)
     405           0 :                    (if (and (consp elt) (eq 'map (car elt)))
     406           0 :                        (map--make-pcase-patterns elt)
     407           0 :                      elt))
     408           0 :                  args)))
     409             : 
     410             : (provide 'map)
     411             : ;;; map.el ends here

Generated by: LCOV version 1.12