unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* [PATCH] Add procedures to convert alists into hash tables
@ 2013-10-20 14:14 David Thompson
  2013-10-20 14:28 ` David Thompson
  2013-10-29 12:38 ` Ludovic Courtès
  0 siblings, 2 replies; 23+ messages in thread
From: David Thompson @ 2013-10-20 14:14 UTC (permalink / raw)
  To: guile-devel

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

Hello all,

When looking through the different hash table implementations available 
(Guile, SRFI-69, and RNRS) I found a useful SRFI-69 procedure that had 
no equivalent in Guile's native hash table API: alist->hash-table.

This patch is an attempt to add that. It works for all four types of 
hash tables: equal?, eq?, eqv? and custom.

- Dave

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

From e303098404321cbe2b978d526ee2737137a5d5b1 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.

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

* doc/ref/api-compound.texi (alist->hash-table): Add docs.
---
 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..9794e28 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 (alist, size)
+Convert @var{alist} into a hash table with minimum number of buckets
+@var{n}. When keys are repeated in @var{alist}, the leftmost association
+takes precedence.
+
+@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;
+
+SCM_DEFINE (scm_alist_to_hash_table, "alist->hash-table", 1, 1, 0,
+	    (SCM alist, SCM n),
+            "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),
+            "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),
+            "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),
+            "Convert @var{alist} into a hash table with minimum number of "
+            "buckets @var{n}.")
+#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
 ;;;
 
-- 
1.8.4.rc3


^ permalink raw reply related	[flat|nested] 23+ messages in thread
end of thread, other threads:[~2014-03-24 22:26 UTC | newest]

Thread overview: 23+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-10-20 14:14 [PATCH] Add procedures to convert alists into hash tables David Thompson
2013-10-20 14:28 ` David Thompson
2013-10-21 17:00   ` Mark H Weaver
2013-10-22  3:03     ` David Thompson
2013-10-28 12:17       ` Chris K. Jester-Young
2013-10-28 23:51         ` David Thompson
2013-10-26 11:41     ` David Thompson
2013-10-29 12:38 ` Ludovic Courtès
2013-10-30 20:19   ` Thompson, David
2013-11-03 12:43     ` Thien-Thi Nguyen
2013-11-05 19:57     ` Mark H Weaver
2013-11-06 12:54       ` Ludovic Courtès
2013-11-06 13:14         ` Thompson, David
2013-11-18  1:50         ` David Thompson
2013-11-18  2:42           ` David Thompson
2013-11-18  3:22             ` Mark H Weaver
2013-11-18 20:32             ` Ludovic Courtès
2013-11-19  2:00               ` David Thompson
2013-11-19  4:06                 ` Mark H Weaver
2013-11-19 13:14                   ` Thompson, David
2014-03-24 21:06               ` Andy Wingo
2014-03-24 22:15                 ` Ludovic Courtès
2014-03-24 22:26                   ` Andy Wingo

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).