Re: [PATCH] Add procedures to convert alists into hash tables

[David Thompson <dthompson2@worcester.edu>]

[-- Attachment #1: Type: text/plain, Size: 1462 bytes --]

On 10/28/2013 08:17 AM, Chris K. Jester-Young wrote:
> On Mon, Oct 21, 2013 at 11:03:41PM -0400, David Thompson wrote:
>> Thank you for taking the time to give some really useful feedback,
>> Mark Weaver. I appreciate it.
> 
> He always writes really detailed reviews, which I highly appreciate. :-)
> 
> On which note, I have an additional nitpick:
> 
>> * libguile/hashtab.h (scm_alist_to_hash_table, scm_alist_to_hashq_table,
>>   scm_alist_to_hashv_table, scm_alist_to_hashx_table): New prototypes.
>>
>> * libguile/hashtab.c (scm_alist_to_hash_table, scm_alist_to_hashq_table,
>>   scm_alist_to_hashv_table, scm_alist_to_hashx_table): New procedures.
>>   (SCM_ALIST_TO_HASH_TABLE): New macro.
> 
> In the GNU ChangeLog format, when you have a list of functions that
> exceed one line, you should close parens at the end of each line and
> reopen on the next. Thus:
> 
> * libguile/hahstab.c (scm_alist_to_hash_table, scm_alist_to_hashq_table)
>   (scm_alist_to_hashv_table, scm_alist_to_hashx_table): New procedures.
> 
>> Good to know. Still trying to get used to this commit format.
> 
> If you're talking about the commit message format, we largely follow the
> GNU ChangeLog format, which is described here:
> http://www.gnu.org/prep/standards/html_node/Style-of-Change-Logs.html
> 
> Cheers,
> Chris.
> 

Thank you, Chris. I'll try my best to follow the GNU ChangeLog format in
the future.

Attached is a patch with an amended commit message.

- Dave

[-- Attachment #2: 0001-Add-procedures-to-convert-alists-into-hash-tables.patch --]
[-- Type: text/x-patch, Size: 7789 bytes --]

From f3cd6ee7fa1b87005ac0c255ec7ab1331abbc88d Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 19 Oct 2013 22:43:37 -0400
Subject: [PATCH] Add procedures to convert alists into hash tables.

* libguile/hashtab.h (scm_alist_to_hash_table, scm_alist_to_hashq_table)
  (scm_alist_to_hashv_table, scm_alist_to_hashx_table): New prototypes.

* libguile/hashtab.c (scm_alist_to_hash_table, scm_alist_to_hashq_table)
  (scm_alist_to_hashv_table, scm_alist_to_hashx_table): New procedures.
  (SCM_ALIST_TO_HASH_TABLE): New macro.

* test-suite/tests/hash.test ("alist->hash-table"): Add tests.

* doc/ref/api-compound.texi (Hash Table Reference): Add docs.
---
 doc/ref/api-compound.texi  | 24 ++++++++++++++++
 libguile/hashtab.c         | 70 ++++++++++++++++++++++++++++++++++++++++++++++
 libguile/hashtab.h         |  5 ++++
 test-suite/tests/hash.test | 35 +++++++++++++++++++++++
 4 files changed, 134 insertions(+)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 94e0145..e13c9c4 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -3829,6 +3829,30 @@ then it can use @var{size} to avoid rehashing when initial entries are
 added.
 @end deffn
 
+@deffn {Scheme Procedure} alist->hash-table alist
+@deffnx {Scheme Procedure} alist->hashq-table alist
+@deffnx {Scheme Procedure} alist->hashv-table alist
+@deffnx {Scheme Procedure} alist->hashx-table hash assoc alist
+@deffnx {C Function} scm_alist_to_hash_table (alist)
+@deffnx {C Function} scm_alist_to_hashq_table (alist)
+@deffnx {C Function} scm_alist_to_hashv_table (alist)
+@deffnx {C Function} scm_alist_to_hashx_table (hash, assoc, alist)
+Convert @var{alist} into a hash table. When keys are repeated in
+@var{alist}, the leftmost association takes precedence.
+
+@example
+(alist->hash-table '((foo . 1) (bar . 2)))
+@end example
+
+When converting to an extended hash table, custom @var{hash} and
+@var{assoc} procedures must be provided.
+
+@example
+(alist->hash-table hash assoc '((foo . 1) (bar . 2)))
+@end example
+
+@end deffn
+
 @deffn {Scheme Procedure} hash-table? obj
 @deffnx {C Function} scm_hash_table_p (obj)
 Return @code{#t} if @var{obj} is a abstract hash table object.
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 88cb199..a79f70f 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -423,6 +423,76 @@ SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0,
 }
 #undef FUNC_NAME
 
+#define SCM_ALIST_TO_HASH_TABLE(alist, hash_create_handle_fn)           \
+  SCM hash_table;                                                       \
+  SCM_VALIDATE_LIST (1, alist);                                         \
+  hash_table = make_hash_table (0, scm_ilength (alist), FUNC_NAME);     \
+  while (!scm_is_null (alist))                                          \
+    {                                                                   \
+      SCM pair = SCM_CAR (alist);                                       \
+      SCM key = scm_car (pair);                                         \
+      SCM value = scm_cdr (pair);                                       \
+      SCM handle = hash_create_handle_fn (hash_table, key,              \
+                                          SCM_UNDEFINED);               \
+      if (SCM_UNBNDP (SCM_CDR (handle)))                                \
+        scm_set_cdr_x (handle, value);                                  \
+      alist = SCM_CDR (alist);                                          \
+    }                                                                   \
+  return hash_table;
+
+SCM_DEFINE (scm_alist_to_hash_table, "alist->hash-table", 1, 0, 0,
+            (SCM alist),
+            "Convert @var{alist} into a hash table.")
+#define FUNC_NAME s_scm_alist_to_hash_table
+{
+  SCM_ALIST_TO_HASH_TABLE (alist, scm_hash_create_handle_x);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_alist_to_hashq_table, "alist->hashq-table", 1, 0, 0,
+            (SCM alist),
+            "Convert @var{alist} into a hash table.")
+#define FUNC_NAME s_scm_alist_to_hashq_table
+{
+  SCM_ALIST_TO_HASH_TABLE (alist, scm_hashq_create_handle_x);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_alist_to_hashv_table, "alist->hashv-table", 1, 0, 0,
+            (SCM alist),
+            "Convert @var{alist} into a hash table.")
+#define FUNC_NAME s_scm_alist_to_hashv_table
+{
+  SCM_ALIST_TO_HASH_TABLE (alist, scm_hashv_create_handle_x);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_alist_to_hashx_table, "alist->hashx-table", 3, 0, 0,
+            (SCM hash, SCM assoc, SCM alist),
+            "Convert @var{alist} into a hash table with custom @var{hash} and"
+            "@var{assoc} procedures.")
+#define FUNC_NAME s_scm_alist_to_hashx_table
+{
+  SCM hash_table;
+  SCM_VALIDATE_LIST (3, alist);
+  hash_table = make_hash_table (0, scm_ilength (alist), FUNC_NAME);
+
+  while (!scm_is_null (alist))
+    {
+      SCM pair = SCM_CAR (alist);
+      SCM key = scm_car (pair);
+      SCM value = scm_cdr (pair);
+      SCM handle = scm_hashx_create_handle_x (hash, assoc, hash_table,
+                                              key, SCM_UNDEFINED);
+      if (SCM_UNBNDP (SCM_CDR (handle)))
+        scm_set_cdr_x (handle, value);
+      alist = SCM_CDR (alist);
+    }
+
+  return hash_table;
+}
+#undef FUNC_NAME
+
 /* The before-gc C hook only runs if GC_set_start_callback is available,
    so if not, fall back on a finalizer-based implementation.  */
 static int
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index dcebcb8..270efe9 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -101,6 +101,11 @@ SCM_API SCM scm_make_weak_key_hash_table (SCM k);
 SCM_API SCM scm_make_weak_value_hash_table (SCM k);
 SCM_API SCM scm_make_doubly_weak_hash_table (SCM k);
 
+SCM_API SCM scm_alist_to_hash_table (SCM alist);
+SCM_API SCM scm_alist_to_hashq_table (SCM alist);
+SCM_API SCM scm_alist_to_hashv_table (SCM alist);
+SCM_API SCM scm_alist_to_hashx_table (SCM hash, SCM assoc, SCM alist);
+
 SCM_API SCM scm_hash_table_p (SCM h);
 SCM_API SCM scm_weak_key_hash_table_p (SCM h);
 SCM_API SCM scm_weak_value_hash_table_p (SCM h);
diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index 3bd4004..820e522 100644
--- a/test-suite/tests/hash.test
+++ b/test-suite/tests/hash.test
@@ -81,6 +81,41 @@
                               (write (make-hash-table 100)))))))
 
 ;;;
+;;; alist->hash-table
+;;;
+
+(with-test-prefix
+  "alist->hash-table"
+
+  ;; equal? hash table
+  (pass-if (let ((table (alist->hash-table '(("foo" . 1)
+                                             ("bar" . 2)
+                                             ("foo" . 3)))))
+             (and (= (hash-ref table "foo") 1)
+                  (= (hash-ref table "bar") 2))))
+
+  ;; eq? hash table
+  (pass-if (let ((table (alist->hashq-table '((foo . 1)
+                                              (bar . 2)
+                                              (foo . 3)))))
+             (and (= (hashq-ref table 'foo) 1)
+                  (= (hashq-ref table 'bar) 2))))
+
+  ;; eqv? hash table
+  (pass-if (let ((table (alist->hashv-table '((1 . 1)
+                                              (2 . 2)
+                                              (1 . 3)))))
+             (and (= (hashv-ref table 1) 1)
+                  (= (hashv-ref table 2) 2))))
+
+  ;; custom hash table
+  (pass-if (let ((table (alist->hashx-table hash assoc '((foo . 1)
+                                                         (bar . 2)
+                                                         (foo . 3)))))
+             (and (= (hashx-ref hash assoc table 'foo) 1)
+                  (= (hashx-ref hash assoc table 'bar) 2)))))
+
+;;;
 ;;; usual set and reference
 ;;;
 
-- 
1.8.4.rc3