diff options
| -rw-r--r-- | ChangeLog | 15 | ||||
| -rw-r--r-- | eval.c | 6 | ||||
| -rw-r--r-- | hash.c | 122 | ||||
| -rw-r--r-- | hash.h | 5 | ||||
| -rw-r--r-- | txr.1 | 58 | ||||
| -rw-r--r-- | txr.vim | 6 |
6 files changed, 209 insertions, 3 deletions
@@ -1,3 +1,18 @@ +2012-09-12 Kaz Kylheku <kaz@kylheku.com> + + * eval.c (eval_init): New intrinsics: make-similar-hash, copy-hash, + hash-uni, hash-diff, hash-isec. + + * hash.c (make_similar_hash, copy_hash, hash_uni, hash_diff, + hash_isec): New functions. + + * hash.h (make_similar_hash, copy_hash, hash_uni, hash_diff, + hash_isec): Declared. + + * txr.1: Updated. + + * txr.vim: Highlighting for these new functions. + 2012-09-11 Kaz Kylheku <kaz@kylheku.com> * configure: Added test for <sys/stat.h> @@ -2238,8 +2238,9 @@ void eval_init(void) reg_fun(intern(lit("match-regex"), user_package), func_n3o(match_regex, 2)); reg_fun(intern(lit("regsub"), user_package), func_n3(regsub)); - reg_fun(intern(lit("make-hash"), user_package), func_n3(make_hash)); + reg_fun(intern(lit("make-similar-hash"), user_package), func_n1(make_similar_hash)); + reg_fun(intern(lit("copy-hash"), user_package), func_n1(copy_hash)); 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)); @@ -2259,6 +2260,9 @@ void eval_init(void) reg_fun(intern(lit("hash-values"), user_package), func_n1(hash_values)); reg_fun(intern(lit("hash-pairs"), user_package), func_n1(hash_pairs)); reg_fun(intern(lit("hash-alist"), user_package), func_n1(hash_alist)); + reg_fun(intern(lit("hash-uni"), user_package), func_n2(hash_uni)); + reg_fun(intern(lit("hash-diff"), user_package), func_n2(hash_diff)); + reg_fun(intern(lit("hash-isec"), user_package), func_n2(hash_isec)); reg_fun(intern(lit("eval"), user_package), func_n2o(eval_intrinsic, 1)); @@ -370,6 +370,51 @@ val make_hash(val weak_keys, val weak_vals, val equal_based) return hash; } +val make_similar_hash(val existing) +{ + struct hash *ex = (struct hash *) cobj_handle(existing, hash_s); + struct hash *h = (struct hash *) chk_malloc(sizeof *h); + val mod = num(256); + val table = vector(mod); + val hash = cobj((mem_t *) h, hash_s, &hash_ops); + + h->modulus = c_num(mod); + h->count = 0; + h->table = table; + h->userdata = ex->userdata; + + h->flags = ex->flags; + h->hash_fun = ex->hash_fun; + h->assoc_fun = ex->assoc_fun; + h->acons_new_l_fun = ex->acons_new_l_fun; + + return hash; +} + +val copy_hash(val existing) +{ + struct hash *ex = (struct hash *) cobj_handle(existing, hash_s); + struct hash *h = (struct hash *) chk_malloc(sizeof *h); + val hash = cobj((mem_t *) h, hash_s, &hash_ops); + val mod = num(ex->modulus); + val iter; + + h->modulus = ex->modulus; + h->count = ex->count; + h->table = vector(mod); + h->userdata = ex->userdata; + + h->flags = ex->flags; + h->hash_fun = ex->hash_fun; + h->assoc_fun = ex->assoc_fun; + h->acons_new_l_fun = ex->acons_new_l_fun; + + for (iter = zero; lt(iter, mod); iter = plus(iter, one)) + *vecref_l(h->table, iter) = copy_alist(vecref(ex->table, iter)); + + return hash; +} + val *gethash_l(val hash, val key, val *new_p) { struct hash *h = (struct hash *) cobj_handle(hash, hash_s); @@ -706,6 +751,83 @@ val hash_alist(val hash) return make_half_lazy_cons(func_f1(iter, hash_alist_lazy), cell); } +val hash_uni(val hash1, val hash2) +{ + struct hash *h1 = (struct hash *) cobj_handle(hash1, hash_s); + struct hash *h2 = (struct hash *) cobj_handle(hash2, hash_s); + + if (h1->hash_fun != h2->hash_fun) + uw_throwf(error_s, lit("hash-uni: ~a and ~a are incompatible hashes"), hash1, hash2, nao); + + { + val hout = make_similar_hash(hash1); + val hiter, entry; + + for (hiter = hash_begin(hash1), entry = hash_next(hiter); + entry; + entry = hash_next(hiter)) + { + sethash(hout, car(entry), cdr(entry)); + } + + for (hiter = hash_begin(hash2), entry = hash_next(hiter); + entry; + entry = hash_next(hiter)) + { + sethash(hout, car(entry), cdr(entry)); + } + + return hout; + } +} + +val hash_diff(val hash1, val hash2) +{ + struct hash *h1 = (struct hash *) cobj_handle(hash1, hash_s); + struct hash *h2 = (struct hash *) cobj_handle(hash2, hash_s); + + if (h1->hash_fun != h2->hash_fun) + uw_throwf(error_s, lit("hash-diff: ~a and ~a are incompatible hashes"), hash1, hash2, nao); + + { + val hout = copy_hash(hash1); + val hiter, entry; + + for (hiter = hash_begin(hash2), entry = hash_next(hiter); + entry; + entry = hash_next(hiter)) + { + remhash(hout, car(entry)); + } + + return hout; + } +} + +val hash_isec(val hash1, val hash2) +{ + struct hash *h1 = (struct hash *) cobj_handle(hash1, hash_s); + struct hash *h2 = (struct hash *) cobj_handle(hash2, hash_s); + + if (h1->hash_fun != h2->hash_fun) + uw_throwf(error_s, lit("hash-uni: ~a and ~a are incompatible hashes"), hash1, hash2, nao); + + { + val hout = make_similar_hash(hash1); + val hiter, entry; + + for (hiter = hash_begin(hash1), entry = hash_next(hiter); + entry; + entry = hash_next(hiter)) + { + if (gethash(hash2, car(entry))) + sethash(hout, car(entry), cdr(entry)); + } + + return hout; + } +} + void hash_init(void) { weak_keys_k = intern(lit("weak-keys"), keyword_package); @@ -27,6 +27,8 @@ extern val weak_keys_k, weak_vals_k, equal_based_k; val make_hash(val weak_keys, val weak_vals, val equal_based); +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 gethash_n(val hash, val key, val notfound_val); @@ -49,6 +51,9 @@ val hash_keys(val hash); val hash_values(val hash); val hash_pairs(val hash); val hash_alist(val hash); +val hash_uni(val hash1, val hash2); +val hash_diff(val hash1, val hash2); +val hash_isec(val hash1, val hash2); void hash_process_weak(void); @@ -8876,6 +8876,29 @@ the equal function instead. In addition to storing key-value pairs, a hash table can have a piece of information associated with it, called the user data. +.SS Functions make-similar-hash and copy-hash + +.TP +Syntax: + + (make-similar-hash <hash>) + (copy-hash <hash>) + +.TP +Description: + +The make-similar-hash and copy-hash functions create a new hash object based on +the existing <hash> object. + +The make-similar-hash produces an empty hash table which inherits all of the +attributes of <hash>. It uses the same kind of key equality, the +same configuration of weak keys and values, and has the same user data (see +the set-hash-userdata function). + +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 sethash .TP @@ -9062,6 +9085,41 @@ The <result-form> and <body-form>-s are in the scope of an implicit anonymous block, which means that it is possible to terminate the execution of dohash early using (return) or (return <value>). +.SS Functions hash-uni, hash-diff and hash-isec + +.TP +Syntax: + + (hash-uni <hash1> <hash2>) + (hash-diff <hash1> <hash2>) + (hash-isec <hash1> <hash2>) + +.TP +Description: + +These functions perform basic set operations on hash tables in a nondestructive +way, returning a new hash table without altering the inputs. The arguments +<hash1> and <hash2> must be compatible hash tables. This means that their keys +must use the same kind of equality. + +The resulting hash table inherits attributes from <hash1>, as if by the +make-similar-hash operation. If <hash1> has userdata, the resulting hash table +has the same userdata. If <hash1> has weak keys, the resulting table has weak +keys, and so forth. + +The hash-uni function performs a set union. The resulting hash contains all of the +keys from <hash1> and all of the keys from <hash2>, and their corresponding values. +If a key occurs both in <hash1> and <hash2>, then it occurs only once in the +resulting hash. The value for this common key is the one from <hash2>. + +The hash-diff function performs a set difference. First, a copy of <hash1> is +made as if by the copy-has function. Then from this copy, all keys which occur +in <hash2> are deleted. + +The hash-isec function performs a set intersection. The resulting hash contains +only those keys which occur both in <hash1> and <hash2>. The values selected +for these common keys are those from <hash1>. + .SH PARTIAL EVALUATION AND COMBINATORS .SS Operator op @@ -49,10 +49,12 @@ syn keyword txl_keyword contained fixnump bignump integerp floatp syn keyword txl_keyword contained numberp zerop evenp oddp > syn keyword txl_keyword contained zerop evenp oddp > < >= <= = max min syn keyword txl_keyword contained search-regex match-regex regsub regexp regex-compile -syn keyword txl_keyword contained make-hash hash hash-construct gethash sethash pushhash remhash +syn keyword txl_keyword contained make-hash make-similar-hash copy-hash hash hash-construct +syn keyword txl_keyword contained gethash sethash pushhash remhash syn keyword txl_keyword contained hash-count get-hash-userdata set-hash-userdata hashp maphash syn keyword txl_keyword contained hash-eql hash-equal -syn keyword txl_keyword contained hash_keys hash_values hash_pairs hash_alist +syn keyword txl_keyword contained hash-keys hash-values hash-pairs hash-alist +syn keyword txl_keyword contained hash-uni hash-diff hash-isec syn keyword txl_keyword contained eval chain andf orf iff syn keyword txl_keyword contained *stdout* *stdin* *stddebug* syn keyword txl_keyword contained *stderr* format print pprint tostring tostringp |