From 4ecca7c0b2ac3d61658d749f51dc1e7fbc408ed8 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 4 Aug 2015 08:37:51 -0700
Subject: * hash.c (hash_revget): New function.

* hash.h (hash_revget): Declared.

* eval.c (eval_init): Registered hash-revget intrinsic.

* txr.1: Documented hash-revget.
---
 ChangeLog | 10 ++++++++++
 eval.c    |  1 +
 hash.c    | 16 ++++++++++++++++
 hash.h    |  1 +
 txr.1     | 44 ++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 72 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index 60f541e2..b1840dfa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2015-08-04  Kaz Kylheku  <kaz@kylheku.com>
+
+	* hash.c (hash_revget): New function.
+
+	* hash.h (hash_revget): Declared.
+
+	* eval.c (eval_init): Registered hash-revget intrinsic.
+
+	* txr.1: Documented hash-revget.
+
 2015-08-04  Kaz Kylheku  <kaz@kylheku.com>
 
 	* stream.c (indent_mode_put_string): Function removed,
diff --git a/eval.c b/eval.c
index bfe7ade2..453c20fb 100644
--- a/eval.c
+++ b/eval.c
@@ -4373,6 +4373,7 @@ void eval_init(void)
   reg_fun(intern(lit("hash-update"), user_package), func_n2(hash_update));
   reg_fun(intern(lit("hash-update-1"), user_package),
           func_n4o(hash_update_1, 3));
+  reg_fun(intern(lit("hash-revget"), user_package), func_n4o(hash_revget, 2));
 
   reg_fun(intern(lit("eval"), user_package), func_n2o(eval_intrinsic, 1));
   reg_fun(intern(lit("lisp-parse"), user_package), func_n4o(lisp_parse, 0));
diff --git a/hash.c b/hash.c
index d279ece8..3aed7b58 100644
--- a/hash.c
+++ b/hash.c
@@ -1149,6 +1149,22 @@ val hash_update_1(val hash, val key, val fun, val init)
   }
 }
 
+val hash_revget(val hash, val value, val test, val keyfun)
+{
+  val iter = hash_begin(hash);
+  val cell;
+
+  test = default_arg(test, eql_f);
+  keyfun = default_arg(keyfun, identity_f);
+
+  while ((cell = hash_next(iter)) != nil) {
+    if (funcall2(test, value, funcall1(keyfun, cdr(cell))))
+      return car(cell);
+  }
+
+  return nil;
+}
+
 void hash_init(void)
 {
   weak_keys_k = intern(lit("weak-keys"), keyword_package);
diff --git a/hash.h b/hash.h
index a732698a..afc24a0c 100644
--- a/hash.h
+++ b/hash.h
@@ -62,6 +62,7 @@ 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);
+val hash_revget(val hash, val value, val test, val keyfun);
 
 void hash_process_weak(void);
 
diff --git a/txr.1 b/txr.1
index a1ff068b..19984c25 100644
--- a/txr.1
+++ b/txr.1
@@ -25301,6 +25301,50 @@ to
 The function returns
 .codn nil .
 
+.coNP Function @ hash-revget
+.synb
+.mets (hash-revget < hash < value >> [ testfun <> [ keyfun ]])
+.syne
+.desc
+The
+.code hash-revget
+function performs a reverse lookup on
+.metn hash .
+
+It searches through the entries stored in
+.meta hash
+for an entry whose value matches
+.metn value .
+
+If such an entry is found, that entry's key is returned.
+Otherwise
+.code nil
+is returned.
+
+If multiple matching entries exist, it is not specified which entry's
+key is returned.
+
+The
+.meta keyfun
+function is applied to each value in
+.meta hash
+and the resulting value is compared with
+.metn value .
+The default
+.meta keyfun
+is the
+.code identity
+function.
+
+The comparison is performed using
+.metn testfun .
+
+The default
+.meta testfun
+is the
+.code eql
+function.
+
 .coNP Functions @ hash-eql and @ hash-equal
 .synb
 .mets (hash-eql << object )
-- 
cgit v1.2.3