diff options
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lisplib.c | 15 | ||||
| -rw-r--r-- | share/txr/stdlib/hash.tl | 41 | ||||
| -rw-r--r-- | txr.1 | 83 |
4 files changed, 141 insertions, 0 deletions
@@ -4499,6 +4499,8 @@ void eval_init(void) 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("hash-begin"), user_package), func_n1(hash_begin)); + reg_fun(intern(lit("hash-next"), user_package), func_n1(hash_next)); reg_fun(intern(lit("eval"), user_package), func_n2o(eval_intrinsic, 1)); reg_fun(intern(lit("lisp-parse"), user_package), func_n5o(lisp_parse, 0)); @@ -214,6 +214,20 @@ static val with_stream_instantiate(val set_fun) return nil; } +static val hash_set_entries(val dlt, val fun) +{ + val name[] = { lit("with-hash-table-iter"), nil }; + set_dlt_entries(dlt, name, fun); + return nil; +} + +static val hash_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(format(nil, lit("~a/hash.tl"), stdlib_path, nao)); + return nil; +} + val dlt_register(val dlt, val (*instantiate)(val), val (*set_entries)(val, val)) @@ -233,6 +247,7 @@ void lisplib_init(void) dlt_register(dl_table, path_test_instantiate, path_test_set_entries); dlt_register(dl_table, struct_instantiate, struct_set_entries); dlt_register(dl_table, with_stream_instantiate, with_stream_set_entries); + dlt_register(dl_table, hash_instantiate, hash_set_entries); } val lisplib_try_load(val sym) diff --git a/share/txr/stdlib/hash.tl b/share/txr/stdlib/hash.tl new file mode 100644 index 00000000..17d0afa2 --- /dev/null +++ b/share/txr/stdlib/hash.tl @@ -0,0 +1,41 @@ +;; Copyright 2015 +;; Kaz Kylheku <kaz@kylheku.com> +;; Vancouver, Canada +;; All rights reserved. +;; +;; Redistribution of this software in source and binary forms, with or without +;; modification, is permitted provided that the following two conditions are met. +;; +;; Use of this software in any manner constitutes agreement with the disclaimer +;; which follows the two conditions. +;; +;; 1. Redistributions of source code must retain the above copyright +;; notice, this list of conditions and the following disclaimer. +;; 2. Redistributions in binary form must reproduce the above copyright +;; notice, this list of conditions and the following disclaimer in +;; the documentation and/or other materials provided with the +;; distribution. +;; +;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED +;; WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF +;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL THE +;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED, +;; AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS +;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(defmacro with-hash-iter ((name hash-form : key val) . body) + (let ((hash (gensym)) + (iter (gensym)) + (next (gensym))) + ^(let* ((,hash ,hash-form) + (,iter (hash-begin ,hash)) + ,*(if key ^((,key))) + ,*(if val ^((,val)))) + (flet ((,name () + ,(if (not (or key val)) + ^(hash-next ,iter) + ^(let ((,next (hash-next ,iter))) + ,*(if key ^((set ,key (car ,next)))) + ,*(if val ^((set ,val (cdr ,next))))) + ,next))) + ,*body)))) @@ -27955,6 +27955,89 @@ applies first, as above. If that is true, and the two hashes have the same number of elements, the result is falsified. +.coNP Function @ hash-begin and @ hash-next +.synb +.mets (hash-begin << hash ) +.mets (hash-next << hash-iter ) +.syne +The +.code hash-begin +function returns a an iterator object capable of retrieving the +entries in stored in +.meta hash +one by one. + +The +.code hash-next +function applies to a hash iterator returned by +.codn hash-begin . + +If unvisited entries remain, it returns the next one as a cons cell +whose +.code car +holds the key and whose +.code cdr +holds the value. + +If no more entries remain to be visited, it returns +.codn nil . + +.coNP Macro @ with-hash-iter +.synb +.mets (with-hash-iter >> ( isym < hash-form >> [ ksym <> [ vsym ]]) +.mets \ \ << body-form *) +.syne +The +.code with-hash-table-iter +macro evaluates +.metn body-form -s +in an environment in which a lexically scoped function is visible. + +The function is named by +.meta isym +which must be a symbol suitable for naming functions with +.codn flet . + +The +.meta hash-form +argument must be a form which evaluates to a hash table object. + +Invocations of the function retrieve successive entries of the hash table +as cons cell pairs of keys and values. The function returns +.code nil +to indicate no more entries remain. + +If either of the +.meta ksym +or +.meta vsym +arguments are present, they must be symbols suitable as variable names. They +are bound as variables visible to +.metn body-form -s, +initialized to the value +.codn nil . + +If +.meta ksym +is specified, then whenever the function +.meta isym +macro is invoked and retrieves a hash table entry, the +.meta ksym +variable is set to the key. If the function returns +.code nil +then the value of +.meta ksym +is set to +.codn nil . + +Similarly, if +.meta vsym +is specified, then the function stores the retrieved +hash value in that variable, or else sets the variable +to +.code nil +if there is no next value. + .SS* Partial Evaluation and Combinators .coNP Macros @ op and @ do .synb |