Hash subset testing.

* eval.c (eval_init): Register hash-subset and hash-proper-subset
intrinsics.

* hash.c (hash_subset, hash_proper_subset): New functions.

* hash.h (hash_subset, hash_proper_subset): Declared.

* txr.1: New functions documented.

5 files changed, 86 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 7cb67847..ec5a5d2d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2015-06-23  Kaz Kylheku  <kaz@kylheku.com>
+
+	Hash subset testing.
+
+	* eval.c (eval_init): Register hash-subset and hash-proper-subset
+	intrinsics.
+
+	* hash.c (hash_subset, hash_proper_subset): New functions.
+
+	* hash.h (hash_subset, hash_proper_subset): Declared.
+
+	* txr.1: New functions documented.
+
 2015-06-22  Kaz Kylheku  <kaz@kylheku.com>
 
 	* genvim.txr: Add ifa.tl library file.
diff --git a/eval.c b/eval.c
index 7d1ef1ae..c61b1460 100644
--- a/eval.c
+++ b/eval.c
@@ -4272,6 +4272,8 @@ void eval_init(void)
   reg_fun(intern(lit("hash-uni"), user_package), func_n3o(hash_uni, 2));
   reg_fun(intern(lit("hash-diff"), user_package), func_n2(hash_diff));
   reg_fun(intern(lit("hash-isec"), user_package), func_n3o(hash_isec, 2));
+  reg_fun(intern(lit("hash-subset"), user_package), func_n2(hash_subset));
+  reg_fun(intern(lit("hash-proper-subset"), user_package), func_n2(hash_proper_subset));
   reg_fun(intern(lit("group-by"), user_package), func_n2v(group_by));
   reg_fun(intern(lit("sort-group"), user_package), func_n3o(sort_group, 1));
   reg_fun(intern(lit("unique"), user_package), func_n2ov(unique, 1));
diff --git a/hash.c b/hash.c
index f4d4dff2..45e18298 100644
--- a/hash.c
+++ b/hash.c
@@ -1065,6 +1065,27 @@ val hash_isec(val hash1, val hash2, val join_func)
   }
 }
 
+val hash_subset(val hash1, val hash2)
+{
+  val hiter, entry;
+
+  for (hiter = hash_begin(hash1), entry = hash_next(hiter);
+       entry;
+       entry = hash_next(hiter))
+  {
+    if (!inhash(hash2, car(entry), colon_k))
+      return nil;
+  }
+
+  return t;
+}
+
+val hash_proper_subset(val hash1, val hash2)
+{
+  return and2(hash_subset(hash1, hash2),
+              null(numeq(hash_count(hash1), hash_count(hash2))));
+}
+
 val hash_update(val hash, val fun)
 {
   val iter = hash_begin(hash);
diff --git a/hash.h b/hash.h
index 76955ac2..6b393b77 100644
--- a/hash.h
+++ b/hash.h
@@ -56,6 +56,8 @@ val hash_alist(val hash);
 val hash_uni(val hash1, val hash2, val join_func);
 val hash_diff(val hash1, val hash2);
 val hash_isec(val hash1, val hash2, val join_func);
+val hash_subset(val hash1, val hash2);
+val hash_proper_subset(val hash1, val hash2);
 val hash_update(val hash, val fun);
 val hash_update_1(val hash, val key, val fun, val init);
 
diff --git a/txr.1 b/txr.1
index 2f0408b8..3a26ad89 100644
--- a/txr.1
+++ b/txr.1
@@ -22348,6 +22348,54 @@ and
 it is called with two arguments: the respective data items. The return
 value is then used as the data item in the intersection hash.
 
+.coNP Functions @ hash-subset and @ hash-proper-subset
+.synb
+.mets (hash-subset < hash1 << hash2 )
+.mets (hash-proper-subset < hash1 << hash2 )
+.syne
+.desc
+The
+.code hash-subset
+function returns
+.code t
+if the keys in
+.meta hash1
+are a subset of the keys in
+.metn hash2 .
+
+The
+.code hash-proper-subset
+function returns
+.code t
+if the keys in
+.meta hash1
+are a proper subset of the keys in
+.metn hash2 .
+This means that
+.meta hash2
+has all the keys which are in
+.meta hash1
+and at least one which isn't.
+
+Note: the return value may not be mathematically meaningful if
+.meta hash1
+and
+.meta hash2
+use different equality. In any case, the actual behavior
+may be understood as follows. The implementation of
+.code hash-subset
+tests whether each of the keys in
+.meta hash1
+occurs in
+.meta hash2
+using their respective equalities.
+The implementation of
+.code hash-proper-subset
+applies
+.code hash-subset
+first, as above. If that is true, and the two hashes have the same number of
+elements, the result is falsified.
+
 .SS* Partial Evaluation and Combinators
 .coNP Macros @ op and @ do
 .synb