From 24f50b052eb8f8fe3a37d60d0a9e6daebab7f84a Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 24 Jan 2014 07:30:00 -0800
Subject: * hash.c (hash_update): New function.

* hash.h (hash_update): Declared.

* lib.c (update): New function.

* lib.h (update): Declared.

* eval.c (eval_init): Register hash_update and update as intrinsics.

* txr.1: Documented.
---
 ChangeLog | 14 ++++++++++++++
 eval.c    |  2 ++
 hash.c    |  9 +++++++++
 hash.h    |  1 +
 lib.c     | 37 +++++++++++++++++++++++++++++++++++++
 lib.h     |  1 +
 txr.1     | 31 +++++++++++++++++++++++++++++++
 7 files changed, 95 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index 1b010072..6dbeb145 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2014-01-24  Kaz Kylheku  <kaz@kylheku.com>
+
+	* hash.c (hash_update): New function.
+
+	* hash.h (hash_update): Declared.
+
+	* lib.c (update): New function.
+
+	* lib.h (update): Declared.
+
+	* eval.c (eval_init): Register hash_update and update as intrinsics.
+
+	* txr.1: Documented.
+
 2014-01-23  Kaz Kylheku  <kaz@kylheku.com>
 
 	* eval.c (expand): Bugfix in expansion of dohash: neglected
diff --git a/eval.c b/eval.c
index 41ebd8bc..7de6de77 100644
--- a/eval.c
+++ b/eval.c
@@ -2467,6 +2467,7 @@ void eval_init(void)
   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("group-by"), user_package), func_n2v(group_by));
+  reg_fun(intern(lit("hash-update"), user_package), func_n2(hash_update));
 
   reg_fun(intern(lit("eval"), user_package), func_n2o(eval_intrinsic, 1));
   reg_fun(intern(lit("lisp-parse"), user_package), func_n2o(lisp_parse, 0));
@@ -2661,6 +2662,7 @@ void eval_init(void)
   reg_fun(intern(lit("ref"), user_package), func_n2(ref));
   reg_fun(intern(lit("refset"), user_package), func_n3(refset));
   reg_fun(intern(lit("replace"), user_package), func_n4o(replace, 2));
+  reg_fun(intern(lit("update"), user_package), func_n2(update));
 
   reg_fun(intern(lit("symbol-value"), user_package), func_n1(symbol_value));
   reg_fun(intern(lit("symbol-function"), user_package), func_n1(symbol_function));
diff --git a/hash.c b/hash.c
index 21168c0c..9befedab 100644
--- a/hash.c
+++ b/hash.c
@@ -858,6 +858,15 @@ val hash_isec(val hash1, val hash2)
   }
 }
 
+val hash_update(val hash, val fun)
+{
+  val iter = hash_begin(hash);
+  val cell;
+  while ((cell = hash_next(iter)) != nil)
+    rplacd(cell, funcall1(fun, cdr(cell)));
+  return hash;
+}
+
 void hash_init(void)
 {
   weak_keys_k = intern(lit("weak-keys"), keyword_package);
diff --git a/hash.h b/hash.h
index f927889c..a71b1ef4 100644
--- a/hash.h
+++ b/hash.h
@@ -55,6 +55,7 @@ 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);
+val hash_update(val hash, val fun);
 
 void hash_process_weak(void);
 
diff --git a/lib.c b/lib.c
index 492e6dcf..63d38183 100644
--- a/lib.c
+++ b/lib.c
@@ -4819,6 +4819,43 @@ val replace(val seq, val items, val from, val to)
   }
 }
 
+val update(val seq, val fun)
+{
+  switch (type(seq)) {
+  case NIL:
+    break;
+  case CONS:
+  case LCONS:
+    {
+      val iter = seq;
+
+      while (consp(iter)) {
+        rplaca(iter, funcall1(fun, car(iter)));
+        iter = cdr(iter);
+      }
+    }
+    break;
+  case LIT:
+  case STR:
+  case VEC:
+    {
+      val len = length(seq);
+      val i;
+      for (i = zero; lt(i, len); i = plus(i, one))
+        refset(seq, i, funcall1(fun, ref(seq, i)));
+    }
+    break;
+  case COBJ:
+    if (hashp(seq))
+      return hash_update(seq, fun);
+    /* fallthrough */
+  default:
+    type_mismatch(lit("replace: ~s is not a sequence"), cons, nao);
+  }
+
+  return seq;
+}
+
 val env(void)
 {
   if (env_list) {
diff --git a/lib.h b/lib.h
index 41465747..5c9b89ce 100644
--- a/lib.h
+++ b/lib.h
@@ -683,6 +683,7 @@ val sub(val seq, val from, val to);
 val ref(val seq, val ind);
 val refset(val seq, val ind, val newval);
 val replace(val seq, val items, val from, val to);
+val update(val seq, val fun);
 val env(void);
 val obj_print(val obj, val stream);
 val obj_pprint(val obj, val stream);
diff --git a/txr.1 b/txr.1
index f3b8696c..c962539c 100644
--- a/txr.1
+++ b/txr.1
@@ -8847,6 +8847,22 @@ can be used in functional programming as higher order functions, whereas the
 bracket notation is syntactic sugar, and set is an operator, not a function.
 Therefore the brackets cannot replace all uses of ref and refset.
 
+.SS Function update
+
+.TP
+Syntax:
+
+  (update <sequence-or-hash> <function>)
+
+.TP
+Description:
+
+The update function replaces each elements in a sequence, or each value
+in a hash table, with the value of <function> applied to that element
+or value.
+
+The sequence or hash table is returned.
+
 .SS Function sort
 
 .TP
@@ -9788,6 +9804,21 @@ 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 Function hash-update
+
+.TP
+Syntax:
+
+  (hash-update <hash> <function>)
+
+.TP
+Description:
+
+The update function replaces each values in <hash>, with the value of
+<function> applied to that value.
+
+The return value is <hash>.
+
 .SS Function group-by
 
 .TP
-- 
cgit v1.2.3