Rounding out hash table functionality with lazy lists that

can walk table content in different ways.

* eval.c (op_dohash): Follow interface change of hash_next.
(eval_init): hash-keys, hash-values, hash-pairs and hash-alist
intrinsics introduced.

* filter.c (trie_compress): Follow interface change of hash_next.

* hash.c (hash_next): Silly interface which takes a pointer to
the iterator has changed to just take the iterator. The function
unambiguously returns nil when the iteration ends, so there
is no need to set the iterator variable to nil.
(maphash): Follows interface change of hash_next.
(hash_keys_lazy, hash_values_lazy, hash_pairs_lazy, hash_alist_lazy):
New static functions.
(hash_keys, hash_values, hash_pairs, hash_alist): New functions.

* hash.h (hash_next): Declaration updated.
(hash_keys, hash_values, hash_pairs, hash_alist): Declared.

* lib.c (make_half_lazy_cons): New way of constructing lazy cons,
with the car field specified.  It simplifies situations when the
previous cons computes the car of the next one. Why hadn't I thought of
this before?

* lib.h (make_half_lazy_cons): Declared.

* txr.1: Doc stubs for new hash functions.

* txr.vim: Highlighting for new hash functions.

9 files changed, 138 insertions, 11 deletions

diff --git a/ChangeLog b/ChangeLog
index 06302f34..325a6edb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,37 @@
+2012-04-07  Kaz Kylheku  <kaz@kylheku.com>
+
+	Rounding out hash table functionality with lazy lists that
+	can walk table content in different ways.
+
+	* eval.c (op_dohash): Follow interface change of hash_next.
+	(eval_init): hash-keys, hash-values, hash-pairs and hash-alist
+	intrinsics introduced.
+
+	* filter.c (trie_compress): Follow interface change of hash_next.
+
+	* hash.c (hash_next): Silly interface which takes a pointer to
+	the iterator has changed to just take the iterator. The function
+	unambiguously returns nil when the iteration ends, so there
+	is no need to set the iterator variable to nil.
+	(maphash): Follows interface change of hash_next.
+	(hash_keys_lazy, hash_values_lazy, hash_pairs_lazy, hash_alist_lazy):
+	New static functions.
+	(hash_keys, hash_values, hash_pairs, hash_alist): New functions.
+
+	* hash.h (hash_next): Declaration updated.
+	(hash_keys, hash_values, hash_pairs, hash_alist): Declared.
+
+	* lib.c (make_half_lazy_cons): New way of constructing lazy cons,
+	with the car field specified.  It simplifies situations when the
+	previous cons computes the car of the next one. Why hadn't I thought of
+	this before?
+
+	* lib.h (make_half_lazy_cons): Declared.
+
+	* txr.1: Doc stubs for new hash functions.
+
+	* txr.vim: Highlighting for new hash functions.
+
 2012-04-05  Kaz Kylheku  <kaz@kylheku.com>
 
 	Version 64
diff --git a/eval.c b/eval.c
index 32be8f2f..a97aa819 100644
--- a/eval.c
+++ b/eval.c
@@ -1035,7 +1035,7 @@ static val op_dohash(val form, val env)
 
   uw_block_begin (nil, result);
 
-  while ((cell = hash_next(&iter)) != nil) {
+  while ((cell = hash_next(iter)) != nil) {
     /* These assignments are gc-safe, because keyvar and valvar
        are newer objects than existing entries in the hash,
        unless the body mutates hash by inserting newer objects,
@@ -2241,6 +2241,10 @@ void eval_init(void)
   reg_fun(intern(lit("maphash"), user_package), func_n2(maphash));
   reg_fun(intern(lit("hash-eql"), user_package), func_n1(hash_eql));
   reg_fun(intern(lit("hash-equal"), user_package), func_n1(hash_equal));
+  reg_fun(intern(lit("hash-keys"), user_package), func_n1(hash_keys));
+  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("eval"), user_package), func_n2o(eval_intrinsic, 1));
 
diff --git a/filter.c b/filter.c
index 0498ced2..9bbe5f1a 100644
--- a/filter.c
+++ b/filter.c
@@ -93,13 +93,13 @@ static void trie_compress(val *ptrie)
       set(*ptrie, value);
     } else if (eq(count, one) && nullp(value)) {
       val iter = hash_begin(trie);
-      val cell = hash_next(&iter);
+      val cell = hash_next(iter);
       set(*ptrie, cons(car(cell), cdr(cell)));
       trie_compress(cdr_l(*ptrie));
     } else {
       val cell, iter = hash_begin(trie);
 
-      for (cell = hash_next(&iter); iter; cell = hash_next(&iter))
+      for (cell = hash_next(iter); cell; cell = hash_next(iter))
         trie_compress(cdr_l(cell));
     }
   } else if (consp(trie)) {
diff --git a/hash.c b/hash.c
index d0bd4ac5..03967967 100644
--- a/hash.c
+++ b/hash.c
@@ -490,18 +490,16 @@ val hash_begin(val hash)
   return hi_obj;
 }
 
-val hash_next(val *iter)
+val hash_next(val iter)
 {
-  struct hash_iter *hi = (struct hash_iter *) cobj_handle(*iter, hash_iter_s);
+  struct hash_iter *hi = (struct hash_iter *) cobj_handle(iter, hash_iter_s);
   val hash = hi->hash;
   struct hash *h = (struct hash *) hash->co.handle;
   if (hi->cons)
     hi->cons = cdr(hi->cons);
   while (nullp(hi->cons)) {
-    if (++hi->chain >= h->modulus) {
-      *iter = nil;
+    if (++hi->chain >= h->modulus)
       return nil;
-    }
     set(hi->cons, vecref(h->table, num(hi->chain)));
   }
   return car(hi->cons);
@@ -511,7 +509,7 @@ val maphash(val fun, val hash)
 {
   val iter = hash_begin(hash);
   val cell;
-  while ((cell = hash_next(&iter)) != nil)
+  while ((cell = hash_next(iter)) != nil)
     funcall2(fun, car(cell), cdr(cell));
   return nil;
 }
@@ -640,6 +638,74 @@ val hash_construct(val hashv_args, val pairs)
   return hash;
 }
 
+static val hash_keys_lazy(val iter, val lcons)
+{
+  val cell = hash_next(iter);
+  set(lcons->lc.cdr, if2(cell, make_half_lazy_cons(lcons->lc.func, car(cell))));
+  return nil;
+}
+
+val hash_keys(val hash)
+{
+  val iter = hash_begin(hash);
+  val cell = hash_next(iter);
+  if (!cell)
+    return nil;
+  return make_half_lazy_cons(func_f1(iter, hash_keys_lazy), car(cell));
+}
+
+static val hash_values_lazy(val iter, val lcons)
+{
+  val cell = hash_next(iter);
+  set(lcons->lc.cdr, if2(cell, make_half_lazy_cons(lcons->lc.func, cdr(cell))));
+  return nil;
+}
+
+val hash_values(val hash)
+{
+  val iter = hash_begin(hash);
+  val cell = hash_next(iter);
+  if (!cell)
+    return nil;
+  return make_half_lazy_cons(func_f1(iter, hash_values_lazy), cdr(cell));
+}
+
+static val hash_pairs_lazy(val iter, val lcons)
+{
+  val cell = hash_next(iter);
+  set(lcons->lc.cdr, if2(cell, make_half_lazy_cons(lcons->lc.func,
+                                                   cons(car(cell),
+                                                        cons(cdr(cell),
+                                                             nil)))));
+  return nil;
+}
+
+val hash_pairs(val hash)
+{
+  val iter = hash_begin(hash);
+  val cell = hash_next(iter);
+  if (!cell)
+    return nil;
+  return make_half_lazy_cons(func_f1(iter, hash_pairs_lazy),
+                             cons(car(cell), cons(cdr(cell), nil)));
+}
+
+static val hash_alist_lazy(val iter, val lcons)
+{
+  val cell = hash_next(iter);
+  set(lcons->lc.cdr, if2(cell, make_half_lazy_cons(lcons->lc.func, cell)));
+  return nil;
+}
+
+val hash_alist(val hash)
+{
+  val iter = hash_begin(hash);
+  val cell = hash_next(iter);
+  if (!cell)
+    return nil;
+  return make_half_lazy_cons(func_f1(iter, hash_alist_lazy), cell);
+}
+
 void hash_init(void)
 {
   weak_keys_k = intern(lit("weak-keys"), keyword_package);
diff --git a/hash.h b/hash.h
index 3796882b..f6f804b5 100644
--- a/hash.h
+++ b/hash.h
@@ -40,11 +40,15 @@ val set_hash_userdata(val hash, val data);
 val hashp(val obj);
 val maphash(val func, val hash);
 val hash_begin(val hash);
-val hash_next(val *iter);
+val hash_next(val iter);
 val hash_eql(val obj);
 val hash_equal(val obj);
 val hashv(val args);
 val hash_construct(val hashv_args, val pairs);
+val hash_keys(val hash);
+val hash_values(val hash);
+val hash_pairs(val hash);
+val hash_alist(val hash);
 
 void hash_process_weak(void);
 
diff --git a/lib.c b/lib.c
index 52197df1..51c584b0 100644
--- a/lib.c
+++ b/lib.c
@@ -1002,6 +1002,16 @@ val make_lazy_cons(val func)
   return obj;
 }
 
+val make_half_lazy_cons(val func, val car)
+{
+  val obj = make_obj();
+  obj->lc.type = LCONS;
+  obj->lc.car = car;
+  obj->lc.cdr = nil;
+  obj->lc.func = func;
+  return obj;
+}
+
 val lcons_fun(val lcons)
 {
   type_check(lcons, LCONS);
diff --git a/lib.h b/lib.h
index 1f8360c1..672f2fcf 100644
--- a/lib.h
+++ b/lib.h
@@ -397,6 +397,7 @@ int in_malloc_range(mem_t *);
 wchar_t *chk_strdup(const wchar_t *str);
 val cons(val car, val cdr);
 val make_lazy_cons(val func);
+val make_half_lazy_cons(val func, val car);
 val lcons_fun(val lcons);
 val list(val first, ...); /* terminated by nao */
 val consp(val obj);
diff --git a/txr.1 b/txr.1
index fcf30689..b3277021 100644
--- a/txr.1
+++ b/txr.1
@@ -7222,6 +7222,8 @@ followed by a period, e or E.
 
 .SS Functions hash-eql and hash-equal
 
+.SS Functions hash_keys hash_values hash_pairs and hash_alist
+ 
 .SS Function eval
 
 .SS Function chain
diff --git a/txr.vim b/txr.vim
index b96801c3..7cb0efd2 100644
--- a/txr.vim
+++ b/txr.vim
@@ -51,7 +51,13 @@ syn keyword txl_keyword contained zerop evenp oddp > < >= <= = max min
 syn keyword txl_keyword contained search-regex match-regex regsub
 syn keyword txl_keyword contained make-hash hash hash-construct 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 eval chain andf orf iff
+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 *stdout* *stdin* *stddebug*
+syn keyword txl_keyword contained *stderr* format print pprint tostring tostringp
+syn keyword txl_keyword contained make-string-input-stream
+syn keyword txl_keyword contained make-string-byte-input-stream make-string-output-stream
+eval chain andf orf iff
 syn keyword txl_keyword contained *stdout* *stdin* *stddebug*
 syn keyword txl_keyword contained *stderr* format print pprint tostring tostringp
 syn keyword txl_keyword contained make-string-input-stream