Update ht.el from v2.0 to 2.2

core/libs/ht.el

@@ -3,8 +3,9 @@
 ;; Copyright (C) 2013 Wilfred Hughes
 
 ;; Author: Wilfred Hughes <me@wilfred.me.uk>
-;; Version: 2.0
+;; Version: 2.2
 ;; Keywords: hash table, hash map, hash
+;; Package-Requires: ((dash "2.12.0"))
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -21,27 +22,29 @@
 
 ;;; Commentary:
 
-;; The missing hash table utility library for Emacs.
+;; The missing hash table library for Emacs.
 ;;
-;; See documentation on https://github.com/Wilfred/ht.el
+;; See documentation at https://github.com/Wilfred/ht.el
 
 ;;; Code:
 
+(require 'dash)
+
 (defmacro ht (&rest pairs)
   "Create a hash table with the key-value pairs given.
 Keys are compared with `equal'.
 
 \(fn (KEY-1 VALUE-1) (KEY-2 VALUE-2) ...)"
   (let* ((table-symbol (make-symbol "ht-temp"))
-        (assignments
-         (mapcar
-          (lambda (pair) `(ht-set! ,table-symbol ,@pair))
-          pairs)))
+         (assignments
+          (mapcar
+           (lambda (pair) `(ht-set! ,table-symbol ,@pair))
+           pairs)))
     `(let ((,table-symbol (ht-create)))
        ,@assignments
        ,table-symbol)))
 
-(defun ht-create (&optional test)
+(defsubst ht-create (&optional test)
   "Create an empty hash table.
 
 TEST indicates the function used to compare the hash
@@ -49,9 +52,13 @@ keys.  Default is `equal'.  It can be `eq', `eql', `equal' or a
 user-supplied test created via `define-hash-table-test'."
   (make-hash-table :test (or test 'equal)))
 
-(defun ht<-alist (alist)
-  "Create a hash table with initial values according to ALIST."
-  (let ((h (ht-create)))
+(defun ht<-alist (alist &optional test)
+  "Create a hash table with initial values according to ALIST.
+
+TEST indicates the function used to compare the hash
+keys.  Default is `equal'.  It can be `eq', `eql', `equal' or a
+user-supplied test created via `define-hash-table-test'."
+  (let ((h (ht-create test)))
     ;; the first key-value pair in an alist gets precedence, so we
     ;; start from the end of the list:
     (dolist (pair (reverse alist) h)
@@ -61,46 +68,34 @@ user-supplied test created via `define-hash-table-test'."
 
 (defalias 'ht-from-alist 'ht<-alist)
 
-;; based on the excellent -partition from dash.el, but we aim to be self-contained
-(defun ht/group-pairs (list)
-  "Return a new list with the items in LIST grouped into pairs.
-Errors if LIST doesn't contain an even number of elements."
-  (let ((result)
-        (sublist)
-        (len 0))
+(defun ht<-plist (plist &optional test)
+  "Create a hash table with initial values according to PLIST.
 
-    (while list
-      ;; take the head of LIST and push onto SUBLIST
-      (setq sublist (cons (car list) sublist))
-      (setq list (cdr list))
-
-      (setq len (1+ len))
-
-      (when (= len 2)
-        ;; push this two-item list onto RESULT
-        (setq result (cons (nreverse sublist) result))
-        (setq sublist nil)
-        (setq len 0)))
-
-    (when sublist (error "Expected an even number of elements"))
-    (nreverse result)))
-
-(defun ht<-plist (plist)
-  "Create a hash table with initial values according to PLIST."
-  (let ((h (ht-create)))
-    (dolist (pair (ht/group-pairs plist) h)
+TEST indicates the function used to compare the hash
+keys.  Default is `equal'.  It can be `eq', `eql', `equal' or a
+user-supplied test created via `define-hash-table-test'."
+  (let ((h (ht-create test)))
+    (dolist (pair (-partition 2 plist) h)
       (let ((key (car pair))
             (value (cadr pair)))
         (ht-set! h key value)))))
 
 (defalias 'ht-from-plist 'ht<-plist)
 
-(defun ht-get (table key &optional default)
+(defsubst ht-get (table key &optional default)
   "Look up KEY in TABLE, and return the matching value.
 If KEY isn't present, return DEFAULT (nil if not specified)."
   (gethash key table default))
 
-(defun ht-set! (table key value)
+(defun ht-get* (table &rest keys)
+  "Look up KEYS in nested hash tables, starting with TABLE.
+The lookup for each key should return another hash table, except
+for the final key, which may return any value."
+  (if (cdr keys)
+      (apply #'ht-get* (ht-get table (car keys)) (cdr keys))
+    (ht-get table (car keys))))
+
+(defsubst ht-set! (table key value)
   "Associate KEY in TABLE with VALUE."
   (puthash key value table)
   nil)
@@ -124,13 +119,13 @@ table is used."
     (mapc (lambda (table) (ht-update! merged table)) tables)
     merged))
 
-(defun ht-remove! (table key)
+(defsubst ht-remove! (table key)
   "Remove KEY from TABLE."
   (remhash key table))
 
 (defalias 'ht-remove 'ht-remove!)
 
-(defun ht-clear! (table)
+(defsubst ht-clear! (table)
   "Remove all keys from TABLE."
   (clrhash table)
   nil)
@@ -175,6 +170,14 @@ For every key-value pair in TABLE, evaluate FORM with the
 variables key and value bound."
   `(ht-each (lambda (key value) ,form) ,table))
 
+(defun ht-select-keys (table keys)
+  "Return a copy of TABLE with only the specified KEYS."
+  (let (result)
+    (setq result (make-hash-table :test (hash-table-test table)))
+    (dolist (key keys result)
+      (if (not (equal (gethash key table 'key-not-found) 'key-not-found))
+          (puthash key (gethash key table) result)))))
+
 (defun ht->plist (table)
   "Return a flat list '(key1 value1 key2 value2...) from TABLE.
 
@@ -188,7 +191,7 @@ inverse of `ht<-plist'.  The following is not guaranteed:
 
 (defalias 'ht-to-plist 'ht->plist)
 
-(defun ht-copy (table)
+(defsubst ht-copy (table)
   "Return a shallow copy of TABLE (keys and values are shared)."
   (copy-hash-table table))
 
@@ -215,11 +218,11 @@ inverse of `ht<-alist'.  The following is not guaranteed:
 
 (defalias 'ht-contains-p 'ht-contains?)
 
-(defun ht-size (table)
+(defsubst ht-size (table)
   "Return the actual number of entries in TABLE."
   (hash-table-count table))
 
-(defun ht-empty? (table)
+(defsubst ht-empty? (table)
   "Return true if the actual number of entries in TABLE is zero."
   (zerop (ht-size table)))
 
@@ -274,5 +277,19 @@ FUNCTION is called with two arguments, KEY and VALUE."
          (throw 'break (list key value))))
      table)))
 
+(defun ht-equal? (table1 table2)
+  "Return t if TABLE1 and TABLE2 have the same keys and values.
+Does not compare equality predicates."
+  (let ((keys1 (ht-keys table1))
+        (keys2 (ht-keys table2))
+        (sentinel (make-symbol "ht-sentinel")))
+    (and (equal (length keys1) (length keys2))
+         (--all?
+          (equal (ht-get table1 it)
+                 (ht-get table2 it sentinel))
+          keys1))))
+
+(defalias 'ht-equal-p 'ht-equal?)
+
 (provide 'ht)
 ;;; ht.el ends here