* eval.c (eval_init): Register inhash as intrinsic.

* hash.c (inhash): New function.

* hash.h (inhash): Declared.

* txr.1: Documented inhash. Also, added surprisingly missing
documentation for gethash!

5 files changed, 73 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index d7eebdaa..90234c48 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2014-02-14  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (eval_init): Register inhash as intrinsic.
+
+	* hash.c (inhash): New function.
+
+	* hash.h (inhash): Declared.
+
+	* txr.1: Documented inhash. Also, added surprisingly missing
+	documentation for gethash!
+
 2014-02-12  Kaz Kylheku  <kaz@kylheku.com>
 
 	* parser.l: Disallow syntax like 1.0a, flagging it as
diff --git a/eval.c b/eval.c
index 92c4afe1..5f88d61c 100644
--- a/eval.c
+++ b/eval.c
@@ -2491,6 +2491,7 @@ void eval_init(void)
   reg_fun(intern(lit("hash"), user_package), func_n0v(hashv));
   reg_fun(intern(lit("hash-construct"), user_package), func_n2(hash_construct));
   reg_fun(gethash_s, func_n3o(gethash_n, 2));
+  reg_fun(intern(lit("inhash"), user_package), func_n3o(inhash, 2));
   reg_fun(intern(lit("sethash"), user_package), func_n3(sethash));
   reg_fun(intern(lit("pushhash"), user_package), func_n3(pushhash));
   reg_fun(intern(lit("remhash"), user_package), func_n2(remhash));
diff --git a/hash.c b/hash.c
index c74a6294..f9548c3c 100644
--- a/hash.c
+++ b/hash.c
@@ -542,6 +542,28 @@ val gethash(val hash, val key)
   return cdr(found);
 }
 
+val inhash(val hash, val key, val init)
+{
+  struct hash *h = (struct hash *) cobj_handle(hash, hash_s);
+  val found;
+
+  if (missingp(init)) {
+    val chain = vecref(h->table, num_fast(h->hash_fun(key) % h->modulus));
+    found = h->assoc_fun(key, chain);
+  } else {
+    val *pchain = vecref_l(h->table, num_fast(h->hash_fun(key) % h->modulus));
+    val old = *pchain, new;
+    val *place = h->acons_new_l_fun(key, &new, pchain);
+    if (old != *pchain && ++h->count > 2 * h->modulus)
+      hash_grow(h);
+    if (new)
+      *place = init;
+    found = h->assoc_fun(key, *pchain);
+  }
+
+  return found;
+}
+
 val gethash_f(val hash, val key, val *found)
 {
   struct hash *h = (struct hash *) cobj_handle(hash, hash_s);
diff --git a/hash.h b/hash.h
index a71b1ef4..5afc9572 100644
--- a/hash.h
+++ b/hash.h
@@ -31,6 +31,7 @@ val make_similar_hash(val existing);
 val copy_hash(val existing);
 val *gethash_l(val hash, val key, val *new_p);
 val gethash(val hash, val key);
+val inhash(val hash, val key, val init);
 val gethash_n(val hash, val key, val notfound_val);
 val gethash_f(val hash, val key, val *found);
 val sethash(val hash, val key, val value);
diff --git a/txr.1 b/txr.1
index 795170c9..b9a884ff 100644
--- a/txr.1
+++ b/txr.1
@@ -10370,6 +10370,44 @@ The copy-hash function is like make-similar-hash, except that instead of
 producing an empty hash table, it produces one which has all the same elements
 as <hash>: it contains the same key and value objects. 
 
+.SS Function inhash
+
+.TP
+Syntax:
+
+  (inhash <hash> <key> [<init>])
+
+.TP
+Description:
+
+The inhash function searches hash table <hash> for <key>. 
+If <key> is found, then it return the hash table's cons cell which 
+represents the association between <hash> and <key>.
+Otherwise, it returns nil.
+
+If argument <init> is specified, then the function will create
+an entry for <key> in <hash> whose value is that of <init>.
+The cons cell representing that association is returned.
+
+Note: for as long as the <key> continues to exist inside <hash>. modifying the
+car field of the returned cons has ramifications for the logical integrity of
+the hash. Modifying the cdr field has the effect of updating the association.
+
+.SS Function gethash
+
+.TP
+Syntax:
+
+  (gethash <hash> <key> [<alt>])
+
+.TP
+Description:
+
+The gethash function searches hash table <hash> for key <key>. If the
+key is found then the associated value is returned. Otherwise, if
+the <alt> argument was specified, it is returned. If the <alt> argument
+was not specified, nil is returned.
+
 .SS Function sethash
 
 .TP