From ed290d6d0df5f4c694459f853983ab79929ea786 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Fri, 14 Feb 2014 15:53:06 -0800 Subject: * 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! --- ChangeLog | 11 +++++++++++ eval.c | 1 + hash.c | 22 ++++++++++++++++++++++ hash.h | 1 + txr.1 | 38 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 73 insertions(+) diff --git a/ChangeLog b/ChangeLog index d7eebdaa..90234c48 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2014-02-14 Kaz Kylheku + + * 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 * 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 : it contains the same key and value objects. +.SS Function inhash + +.TP +Syntax: + + (inhash []) + +.TP +Description: + +The inhash function searches hash table for . +If is found, then it return the hash table's cons cell which +represents the association between and . +Otherwise, it returns nil. + +If argument is specified, then the function will create +an entry for in whose value is that of . +The cons cell representing that association is returned. + +Note: for as long as the continues to exist inside . 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 []) + +.TP +Description: + +The gethash function searches hash table for key . If the +key is found then the associated value is returned. Otherwise, if +the argument was specified, it is returned. If the argument +was not specified, nil is returned. + .SS Function sethash .TP -- cgit v1.2.3