From 8ee92a458a4b854b4a7e726975c1197be877c500 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 28 Jun 2023 20:35:28 -0700
Subject: New function: hash-map.

hash-map converts a function mapping over a sequence
into a hash table.

* hash.[ch] (hash_map): New function.

* tests/010/hash.tl: Test case.

* genman.txr: The hash-map identifier introduces
a hash collision. We have to deal with that somehow now.
(colli): We put the conflicting entries into a new hash called
colli which maps them to an increment value.
(hash-title): Increment the hash code h by the amount
indicated in colli, if the title is found there.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.
---
 genman.txr         |  2 ++
 hash.c             | 14 ++++++++++++++
 hash.h             |  1 +
 stdlib/doc-syms.tl |  1 +
 tests/010/hash.tl  |  3 +++
 txr.1              | 32 ++++++++++++++++++++++++++++++++
 6 files changed, 53 insertions(+)

diff --git a/genman.txr b/genman.txr
index dcc0afd9..eaf90858 100644
--- a/genman.txr
+++ b/genman.txr
@@ -13,6 +13,7 @@
    (defvarl tagnum (hash :equal-based))
    (defvarl disamb (hash :equal-based))
    (defvarl dist-counter 0)
+   (defvarl colli (hash-props "Function <tt>hash-map</tt>" 1))
 
    (defun hash-str (str)
      (for ((lim (len str)) (i 0) (h 0) g) ((< i lim) h) ((inc i))
@@ -22,6 +23,7 @@
 
    (defun hash-title (title)
      (let* ((h (logtrunc (hash-str title) 32))
+            (h (+ h (or [colli title] 0)))
             (existing [dupes h]))
        (when existing
          (unless (equal title existing)
diff --git a/hash.c b/hash.c
index 432e8468..8932a856 100644
--- a/hash.c
+++ b/hash.c
@@ -1694,6 +1694,19 @@ val hash_from_alist_v(val alist, struct args *hashv_args)
   return hash;
 }
 
+val hash_map(val fun, val seq, struct args *hashv_args)
+{
+  val self = lit("hash-map");
+  seq_iter_t iter;
+  val hash = hashv(hashv_args), elem;
+  seq_iter_init(self, &iter, seq);
+
+  while (seq_get(&iter, &elem))
+    sethash(hash, elem, funcall1(fun, elem));
+
+  return hash;
+}
+
 val hash_props(struct args *plist)
 {
   val self = lit("hash-props");
@@ -2222,6 +2235,7 @@ void hash_init(void)
   reg_fun(hash_construct_s, func_n2(hash_construct));
   reg_fun(intern(lit("hash-from-pairs"), user_package), func_n1v(hash_from_pairs_v));
   reg_fun(intern(lit("hash-from-alist"), user_package), func_n1v(hash_from_alist_v));
+  reg_fun(intern(lit("hash-map"), user_package), func_n2v(hash_map));
   reg_fun(intern(lit("hash-props"), user_package), func_n0v(hash_props));
   reg_fun(intern(lit("hash-list"), user_package), func_n1v(hash_list));
   reg_fun(intern(lit("hash-zip"), user_package), func_n2v(hash_zip));
diff --git a/hash.h b/hash.h
index e4a67086..49af9c5a 100644
--- a/hash.h
+++ b/hash.h
@@ -83,6 +83,7 @@ val hashl(val args);
 val hash_construct(val hashl_args, val pairs);
 val hash_from_pairs_v(val pairs, struct args *hashv_args);
 val hash_from_alist_v(val alist, struct args *hashv_args);
+val hash_map(val fun, val seq, struct args *hashv_args);
 val hash_props(struct args *plist);
 val hash_list(val keys, struct args *hashv_args);
 val hash_zip(val keys, val vals, struct args *hashv_args);
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index a46abbd0..4d4ee04d 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -952,6 +952,7 @@
       ("hash-keys" "N-00C9B125")
       ("hash-keys-of" "N-02FBE776")
       ("hash-list" "N-02EE9235")
+      ("hash-map" "N-027671E9")
       ("hash-next" "N-0225209D")
       ("hash-pairs" "N-00C9B125")
       ("hash-peek" "N-0225209D")
diff --git a/tests/010/hash.tl b/tests/010/hash.tl
index 5af8b167..db8f07aa 100644
--- a/tests/010/hash.tl
+++ b/tests/010/hash.tl
@@ -60,3 +60,6 @@
     (let ((items (build (whilet ((cell (hash-next i)))
                           (add (car cell))))))
       (test (diff 0..200 items) nil))))
+
+(test [hash-map square '(1 2 3)]
+      #H(() (1 1) (2 4) (3 9)))
diff --git a/txr.1 b/txr.1
index 3a2528ef..8443e808 100644
--- a/txr.1
+++ b/txr.1
@@ -55848,6 +55848,38 @@ The returned hash table is
 and no parameters are available for customizing any of
 its properties, such as weakness.
 
+.coNP Function @ hash-map
+.synb
+.mets (hash-map < fun < sequence << hash-arg *)
+.syne
+.desc
+The
+.code hash-map
+function constructs a function out of a
+.metn sequence .
+The
+.meta fun
+argument must be a function that can be called with one argument.
+
+The elements of
+.meta sequence
+become the hash keys. The value associated with each key
+is determined by passing that value to function
+.meta fun
+and taking the returned value.
+
+The remaining
+.meta hash-arg
+arguments determine what kind of hash table is created,
+as if they were applied to the
+.code hash
+function.
+
+If the sequence contains duplicate elements (according to the
+hash table equality in effect for the hash table being
+constructed), duplicate elements later in the sequence
+replace earlier elements.
+
 .coNP Function @ hash-update
 .synb
 .mets (hash-update < hash << function )
-- 
cgit v1.2.3