>From f971e341d6ead7ee0c082030672b25fee640be2d Mon Sep 17 00:00:00 2001 From: David Thompson 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 address@hidden {Scheme Procedure} alist->hash-table alist address@hidden {Scheme Procedure} alist->hashq-table alist address@hidden {Scheme Procedure} alist->hashv-table alist address@hidden {Scheme Procedure} alist->hashx-table hash assoc alist address@hidden {C Function} scm_alist_to_hash_table (alist) address@hidden {C Function} scm_alist_to_hashq_table (alist) address@hidden {C Function} scm_alist_to_hashv_table (alist) address@hidden {C Function} scm_alist_to_hashx_table (hash, assoc, alist) +Convert @var{alist} into a hash table. When keys are repeated in address@hidden, the leftmost association takes precedence. + address@hidden +(alist->hash-table '((foo . 1) (bar . 2))) address@hidden example + +When converting to an extended hash table, custom @var{hash} and address@hidden procedures must be provided. + address@hidden +(alist->hash-table hash assoc '((foo . 1) (bar . 2))) address@hidden example + address@hidden 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