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

[David Thompson <dthompson2@worcester.edu>]

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

Thank you for taking the time to give some really useful feedback, Mark 
Weaver. I appreciate it.

On 10/21/2013 01:00 PM, Mark H Weaver wrote:
> Hi David,
>
>>  From 46b7905727ad2efed2dc1d1aca4d4ad00d8f48c5 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.c (scm_alist_to_hash_table, scm_alist_to_hashq_table,
>>    scm_alist_to_hashv_table, scm_alist_to_hashx_table): Add the
>>    equivalent of SRFI-69's alist->hash-table procedure for the native
>>    hash table implementation.
>
> In general, commit logs shouldn't describe what the new procedures do,
> nor should they provide rationale.  Those things belong in code
> comments.  Here, it is sufficient to write "New procedures."
>
> You should also mention the new macro SCM_ALIST_TO_HASH_TABLE, as well
> as the new prototypes in hashtab.h.
>
>> * test-suite/tests/hash.test ("alist->hash-table"): Add tests.
>>
>> * doc/ref/api-compound.texi (alist->hash-table): Add docs.
>
> For .texi files, the part in parentheses here should be the node name
> where the changes were made.  To find it, I usually search backwards for
> "@node".  In this case, the node name is "Hash Table Reference".

Good to know. Still trying to get used to this commit format.

>
>> ---
>>   doc/ref/api-compound.texi  | 18 ++++++++++++++
>>   libguile/hashtab.c         | 61 ++++++++++++++++++++++++++++++++++++++++++++++
>>   libguile/hashtab.h         |  6 +++++
>>   test-suite/tests/hash.test | 27 ++++++++++++++++++++
>>   4 files changed, 112 insertions(+)
>>
>> diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
>> index 94e0145..06115be 100644
>> --- a/doc/ref/api-compound.texi
>> +++ b/doc/ref/api-compound.texi
>> @@ -3829,6 +3829,24 @@ then it can use @var{size} to avoid rehashing when initial entries are
>>   added.
>>   @end deffn
>>
>> +@deffn {Scheme Procedure} alist->hash-table alist [size]
>> +@deffnx {Scheme Procedure} alist->hashq-table alist [size]
>> +@deffnx {Scheme Procedure} alist->hashv-table alist [size]
>> +@deffnx {Scheme Procedure} alist->hashx-table hash assoc alist [size]
>> +@deffnx {C Function} scm_alist_to_hash_table (alist, size)
>> +@deffnx {C Function} scm_alist_to_hashq_table (alist, size)
>> +@deffnx {C Function} scm_alist_to_hashv_table (alist, size)
>> +@deffnx {C Function} scm_alist_to_hashx_table (hash, assoc, alist, size)
>> +Convert @var{alist} into a hash table with minimum number of buckets
>> +@var{size}. When keys are repeated in @var{alist}, the leftmost
>> +association takes precedence.
>
> A few thoughts:
>
> * Are you sure that the leftmost association takes precedence?  From
>    looking at the code, I'd expect the _rightmost_ association to take
>    precedence.  In either case, since it's mentioned explicitly in the
>    docs, it would be good if the test suite checked this.

You are right. I have changed the code such that the leftmost 
association actually takes precedence and the tests check for this.
>
> * For 'alist->hashx-table' (and 'scm_alist_to_hashx_table') the 'hash'
>    and 'assoc' arguments should probably be mentioned, and it would be
>    good to include an example of its use.
>
> * I'm not sure the 'size' argument is worth keeping here.  It seems to
>    me that it will rarely be used.  It might be better to instead compute
>    the size automatically from the alist.  What do you think?
>
>    If you did this, you should use the internal 'scm_ilength' function,
>    which is robust against improper lists and even circular lists, in
>    which case it returns -1.  (In fact, SCM_VALIDATE_LIST works by simply
>    calling scm_ilength and checking that the result is non-negative.)

'size' argument is gone in favor of using 'scm_ilength'.

>
>> +@example
>> +(alist->hash-table '((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..c215269 100644
>> --- a/libguile/hashtab.c
>> +++ b/libguile/hashtab.c
>> @@ -423,6 +423,67 @@ SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0,
>>   }
>>   #undef FUNC_NAME
>>
>> +#define SCM_ALIST_TO_HASH_TABLE(alist, n, hash_set_fn) \
>> +  SCM hash_table; \
>> +  SCM_VALIDATE_LIST (1, alist); \
>> +  hash_table = scm_make_hash_table (n); \
>> +  while (!scm_is_null (alist)) { \
>> +    SCM pair = SCM_CAR (alist); \
>> +    hash_set_fn (hash_table, scm_car (pair), scm_cdr (pair));   \
>> +    alist = SCM_CDR (alist); \
>> +  } \
>> +  return hash_table;
>
> This is a nitpick, but according to our usual style, the backslashes
> should be lined up in a single column.

Much prettier.

>
>> +
>> +SCM_DEFINE (scm_alist_to_hash_table, "alist->hash-table", 1, 1, 0,
>> +	    (SCM alist, SCM n),
>
> More nitpicking: there's a tab in the line above, which messes up the
> indentation.

When kill/yank goes wrong. Fixed.

>
>> +            "Convert @var{alist} into a hash table with minimum number of "
>> +            "buckets @var{n}.")
>> +#define FUNC_NAME s_scm_alist_to_hash_table
>> +{
>> +  SCM_ALIST_TO_HASH_TABLE (alist, n, scm_hash_set_x);
>> +}
>> +#undef FUNC_NAME
>> +
>> +SCM_DEFINE (scm_alist_to_hashq_table, "alist->hashq-table", 1, 1, 0,
>> +	    (SCM alist, SCM n),
>
> Ditto ^^
>
>> +            "Convert @var{alist} into a hash table with minimum number of "
>> +            "buckets @var{n}.")
>> +#define FUNC_NAME s_scm_alist_to_hashq_table
>> +{
>> +  SCM_ALIST_TO_HASH_TABLE (alist, n, scm_hashq_set_x);
>> +}
>> +#undef FUNC_NAME
>> +
>> +SCM_DEFINE (scm_alist_to_hashv_table, "alist->hashv-table", 1, 1, 0,
>> +	    (SCM alist, SCM n),
>
> Ditto ^^
>
>> +            "Convert @var{alist} into a hash table with minimum number of "
>> +            "buckets @var{n}.")
>> +#define FUNC_NAME s_scm_alist_to_hashv_table
>> +{
>> +  SCM_ALIST_TO_HASH_TABLE (alist, n, scm_hashv_set_x);
>> +}
>> +#undef FUNC_NAME
>> +
>> +SCM_DEFINE (scm_alist_to_hashx_table, "alist->hashx-table", 3, 1, 0,
>> +	    (SCM hash, SCM assoc, SCM alist, SCM n),
>
> Ditto ^^
>
>> +            "Convert @var{alist} into a hash table with minimum number of "
>> +            "buckets @var{n}.")
>
> Please mention the 'hash' and 'assoc' arguments in the docstring.

Mentioned.

>
>> +#define FUNC_NAME s_scm_alist_to_hashx_table
>> +{
>> +  SCM hash_table;
>> +  SCM_VALIDATE_LIST (3, alist);
>> +  hash_table = scm_make_hash_table (n);
>> +
>> +  while (!scm_is_null (alist)) {
>> +    SCM pair = SCM_CAR (alist);
>> +    scm_hashx_set_x (hash, assoc, hash_table, scm_car (pair), scm_cdr (pair));
>> +    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..da4f28c 100644
>> --- a/libguile/hashtab.h
>> +++ b/libguile/hashtab.h
>> @@ -101,6 +101,12 @@ 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 n);
>> +SCM_API SCM scm_alist_to_hashq_table (SCM alist, SCM n);
>> +SCM_API SCM scm_alist_to_hashv_table (SCM alist, SCM n);
>> +SCM_API SCM scm_alist_to_hashx_table (SCM hash, SCM assoc,
>> +                                      SCM alist, SCM n);
>> +
>>   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..b09c0b8 100644
>> --- a/test-suite/tests/hash.test
>> +++ b/test-suite/tests/hash.test
>> @@ -81,6 +81,33 @@
>>                                 (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)))))
>> +             (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)))))
>> +             (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)))))
>> +             (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)))))
>> +             (and (= (hashx-ref hash assoc table 'foo) 1)
>> +                  (= (hashx-ref hash assoc table 'bar) 2)))))
>> +
>> +;;;
>>   ;;; usual set and reference
>>   ;;;

Updated patch attached.

- Dave

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

From f971e341d6ead7ee0c082030672b25fee640be2d 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         | 67 ++++++++++++++++++++++++++++++++++++++++++++++
 libguile/hashtab.h         |  5 ++++
 test-suite/tests/hash.test | 35 ++++++++++++++++++++++++
 4 files changed, 131 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..8bf5230 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -423,6 +423,73 @@ SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0,
 }
 #undef FUNC_NAME
 
+#define SCM_ALIST_TO_HASH_TABLE(alist, hash_set_fn, hash_get_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);                                         \
+    if (scm_is_false (hash_get_handle_fn (hash_table, key))) {          \
+      hash_set_fn (hash_table, key, 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_set_x, scm_hash_get_handle);
+}
+#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_set_x, scm_hashq_get_handle);
+}
+#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_set_x, scm_hashv_get_handle);
+}
+#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);
+
+    if (scm_is_false (scm_hashx_get_handle (hash, assoc, hash_table, key))) {
+      scm_hashx_set_x (hash, assoc, hash_table, key, 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