From 9273e90571ff155477aaadd55040fe75e4a8d9e2 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 14 Feb 2014 16:20:17 -0800
Subject: * eval.c (eval_init): Registered hash_update_1 as intrinsic.

* hash.c (hash_update_1): New function.

* hash.h (hash_update_1): Declared.

* txr.1: Documented hash-update-1.
---
 ChangeLog | 10 ++++++++++
 eval.c    |  2 ++
 hash.c    | 19 +++++++++++++++++++
 hash.h    |  1 +
 txr.1     | 26 +++++++++++++++++++++++++-
 5 files changed, 57 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index 8f624b30..e4ce63d9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2014-02-14  Kaz Kylheku  <kaz@kylheku.com>
+
+	* eval.c (eval_init): Registered hash_update_1 as intrinsic.
+
+	* hash.c (hash_update_1): New function.
+
+	* hash.h (hash_update_1): Declared.
+
+	* txr.1: Documented hash-update-1.
+
 2014-02-14  Kaz Kylheku  <kaz@kylheku.com>
 
 	* hash.c (inhash): Rename local variable from new to new_p.
diff --git a/eval.c b/eval.c
index e32ed23b..bb2365bf 100644
--- a/eval.c
+++ b/eval.c
@@ -2513,6 +2513,8 @@ void eval_init(void)
   reg_fun(intern(lit("hash-isec"), user_package), func_n3o(hash_isec, 2));
   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("hash-update-1"), user_package),
+          func_n4o(hash_update_1, 3));
 
   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));
diff --git a/hash.c b/hash.c
index 2e8d6231..1ee0a248 100644
--- a/hash.c
+++ b/hash.c
@@ -1019,6 +1019,25 @@ val hash_update(val hash, val fun)
   return hash;
 }
 
+val hash_update_1(val hash, val key, val fun, val init)
+{
+  if (missingp(init)) {
+    val cons;
+    val data = gethash_f(hash, key, &cons);
+    if (cons)
+      rplacd(cons, funcall1(fun, data));
+    return data;
+  } else {
+    val new_p;
+    val *place = gethash_l(hash, key, &new_p);
+    if (new_p)
+      *place = funcall1(fun, init);
+    else
+      *place = funcall1(fun, *place);
+    return *place;
+  }
+}
+
 void hash_init(void)
 {
   weak_keys_k = intern(lit("weak-keys"), keyword_package);
diff --git a/hash.h b/hash.h
index 52783d37..0b293801 100644
--- a/hash.h
+++ b/hash.h
@@ -57,6 +57,7 @@ val hash_uni(val hash1, val hash2, val join_func);
 val hash_diff(val hash1, val hash2);
 val hash_isec(val hash1, val hash2, val join_func);
 val hash_update(val hash, val fun);
+val hash_update_1(val hash, val key, val fun, val init);
 
 void hash_process_weak(void);
 
diff --git a/txr.1 b/txr.1
index b537e1ed..dc692dd2 100644
--- a/txr.1
+++ b/txr.1
@@ -10311,11 +10311,35 @@ Syntax:
 .TP
 Description:
 
-The update function replaces each values in <hash>, with the value of
+The hash-update function replaces each values in <hash>, with the value of
 <function> applied to that value.
 
 The return value is <hash>.
 
+.SS Function hash-update-1
+
+.TP
+Syntax:
+
+  (hash-update-1 <hash> <key> <function> [<init>])
+
+.TP
+Description:
+
+The hash-update-1 function operates on a single entry in the hash table.
+
+If <key> exists in the hash table, then its corresponding value is passed
+into <function>, and the return value of <function> is then installed
+in place of the key's value. The value is then returned.
+
+If <key> does not exist in the hash table, and no <init> argument is given,
+then the function does nothing and returns nil.
+
+If <key> does not exist in the hash table, and an <init> argument is given,
+then <function> is applied to <init>, and then <key> is inserted into
+<hash> with the value returned by <function> as the datum. This value
+is also returned.
+
 .SS Function group-by
 
 .TP
-- 
cgit v1.2.3