From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: David Thompson Newsgroups: gmane.lisp.guile.devel Subject: Re: [PATCH] Add procedures to convert alists into hash tables Date: Mon, 28 Oct 2013 19:51:43 -0400 Message-ID: <526EF88F.9030603@worcester.edu> References: <5263E55A.6040307@worcester.edu> <5263E891.3030801@worcester.edu> <87r4beftk7.fsf@netris.org> <5265EB0D.2050802@worcester.edu> <20131028121757.GA11365@lotus.destinee.acro.gen.nz> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------060700080508030707070605" X-Trace: ger.gmane.org 1383004315 13191 80.91.229.3 (28 Oct 2013 23:51:55 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 28 Oct 2013 23:51:55 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Oct 29 00:51:59 2013 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VawbG-0000ki-St for guile-devel@m.gmane.org; Tue, 29 Oct 2013 00:51:59 +0100 Original-Received: from localhost ([::1]:43603 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VawbG-0003OB-6W for guile-devel@m.gmane.org; Mon, 28 Oct 2013 19:51:58 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:40213) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Vawb6-0003Np-Uu for guile-devel@gnu.org; Mon, 28 Oct 2013 19:51:54 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Vawaz-0007Cn-RO for guile-devel@gnu.org; Mon, 28 Oct 2013 19:51:48 -0400 Original-Received: from na3sys009aog133.obsmtp.com ([74.125.149.82]:59207) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Vawaz-0007Cb-FV for guile-devel@gnu.org; Mon, 28 Oct 2013 19:51:41 -0400 Original-Received: from mail-yh0-f52.google.com ([209.85.213.52]) (using TLSv1) by na3sys009aob133.postini.com ([74.125.148.12]) with SMTP ID DSNKUm74jAKOs0Xu6jPRbTbYumHdPJYdgwxC@postini.com; Mon, 28 Oct 2013 16:51:41 PDT Original-Received: by mail-yh0-f52.google.com with SMTP id i72so3128957yha.11 for ; Mon, 28 Oct 2013 16:51:39 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:message-id:date:from:user-agent:mime-version:to :subject:references:in-reply-to:content-type; bh=TtnUmUqLMQkJNlRvmg1uOOP+5018C+F2pkMIlGEdmkA=; b=alwDFIzE1BapB92W3Uw/zJiMMTbM2x5Pjj/x/BzDJHmSq5NggIlNWsuu7t1edEr3ca G1Gpi/gBDAtiFq8ou06p3tF5ntsCRoZG8KtS6l2O2hA+5Q5FOD/MNEpte6o0eCJihLQs ap13gcD50wl5bHOUInFP2RxwANE+j+ifMFWgaPVSXD/RTR4n3TZeLKyqH3wiDs8FNuL4 QhMsIQYcVdnpkAGXrOH8Xo7L2jKnz16Dm+K5e+BTTtmESjFny3aQH5eRMzExVRRFQs3f TTFn/ClnP4NN1sl+s9OaqWHdNissUpRl8ytGVIQ6EMaTlRdORQEBEMlviOJzilnz9EVR EXpg== X-Gm-Message-State: ALoCoQkj470SVVSdnQco/8/2gsGkA7i5Un0z1paqyGZ6VVQiT79lYy55gn3P+kxJRD6KIdrm5I4sRuUQo5ZptmicZlQIuyVmACGRIE7RJkrHojYcQ10Tdl/uOfNOb69d5wLNTjbyYMY09R125D4Y9qe07kFkuxc2Ww== X-Received: by 10.236.188.232 with SMTP id a68mr17697207yhn.8.1383004299342; Mon, 28 Oct 2013 16:51:39 -0700 (PDT) X-Received: by 10.236.188.232 with SMTP id a68mr17697196yhn.8.1383004299144; Mon, 28 Oct 2013 16:51:39 -0700 (PDT) Original-Received: from [192.168.1.124] (209-6-40-86.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com. [209.6.40.86]) by mx.google.com with ESMTPSA id e10sm36279748yhj.1.2013.10.28.16.51.37 for (version=TLSv1 cipher=ECDHE-RSA-RC4-SHA bits=128/128); Mon, 28 Oct 2013 16:51:38 -0700 (PDT) User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20131005 Icedove/17.0.9 In-Reply-To: <20131028121757.GA11365@lotus.destinee.acro.gen.nz> X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.4.x X-Received-From: 74.125.149.82 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:16692 Archived-At: This is a multi-part message in MIME format. --------------060700080508030707070605 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 7bit 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 --------------060700080508030707070605 Content-Type: text/x-patch; name="0001-Add-procedures-to-convert-alists-into-hash-tables.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-Add-procedures-to-convert-alists-into-hash-tables.patch" >From f3cd6ee7fa1b87005ac0c255ec7ab1331abbc88d 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 | 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 --------------060700080508030707070605--