From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ted Zlatanov Newsgroups: gmane.emacs.devel Subject: Re: hash-table-{to, from}-alist Date: Tue, 02 Dec 2008 14:56:00 -0600 Organization: =?utf-8?B?0KLQtdC+0LTQvtGAINCX0LvQsNGC0LDQvdC+0LI=?= @ Cienfuegos Message-ID: <86r64q70v3.fsf@lifelogs.com> References: <863aknitfg.fsf@lifelogs.com> <86bpwe9su5.fsf@lifelogs.com> <867i6z1jo5.fsf_-_@lifelogs.com> <86ej14vhvg.fsf@lifelogs.com> <20081122054510.GA28298@tomas> <873ahkkkt5.fsf@xemacs.org> <20081122152126.GA4142@tomas> <87vdufk6do.fsf@xemacs.org> <867i6tt4yz.fsf@lifelogs.com> <87bpw4k1z6.fsf@xemacs.org> <86bpw3d829.fsf@lifelogs.com> <87k5ari5jh.fsf@xemacs.org> <86prkiiia2.fsf@lifelogs.com> <86ej0ygr5j.fsf@lifelogs.com> <861vwygpc6.fsf@lifelogs.com> <868wqzd06x.fsf@lifelogs.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1228251442 17035 80.91.229.12 (2 Dec 2008 20:57:22 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 2 Dec 2008 20:57:22 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Dec 02 21:58:25 2008 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1L7cK2-0007ZJ-I8 for ged-emacs-devel@m.gmane.org; Tue, 02 Dec 2008 21:58:18 +0100 Original-Received: from localhost ([127.0.0.1]:59811 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1L7cIr-0000G1-Ov for ged-emacs-devel@m.gmane.org; Tue, 02 Dec 2008 15:57:05 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1L7cIn-0000Fm-6S for emacs-devel@gnu.org; Tue, 02 Dec 2008 15:57:01 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1L7cIl-0000FR-OV for emacs-devel@gnu.org; Tue, 02 Dec 2008 15:56:59 -0500 Original-Received: from [199.232.76.173] (port=48395 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1L7cIl-0000FO-Hu for emacs-devel@gnu.org; Tue, 02 Dec 2008 15:56:59 -0500 Original-Received: from main.gmane.org ([80.91.229.2]:34561 helo=ciao.gmane.org) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1L7cIk-0001eS-UJ for emacs-devel@gnu.org; Tue, 02 Dec 2008 15:56:59 -0500 Original-Received: from list by ciao.gmane.org with local (Exim 4.43) id 1L7cIc-0005dt-33 for emacs-devel@gnu.org; Tue, 02 Dec 2008 20:56:50 +0000 Original-Received: from 38.98.147.130 ([38.98.147.130]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 02 Dec 2008 20:56:50 +0000 Original-Received: from tzz by 38.98.147.130 with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 02 Dec 2008 20:56:50 +0000 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 284 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: 38.98.147.130 X-Face: bd.DQ~'29fIs`T_%O%C\g%6jW)yi[zuz6; d4V0`@y-~$#3P_Ng{@m+e4o<4P'#(_GJQ%TT= D}[Ep*b!\e,fBZ'j_+#"Ps?s2!4H2-Y"sx" User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/23.0.60 (gnu/linux) Cancel-Lock: sha1:nW1atdYq/IX+YyP9gbkaaS7XoUE= X-detected-operating-system: by monty-python.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:106437 Archived-At: --=-=-= The attached patch does print and read of hashtables. It respects print-length only, exactly like vector print and consistent with the rest of GNU Emacs. Please review and comment. Some notes: I ended up with this code to put a list into Fmake_hash_table format ('params' is a Lisp_Object that holds a bunch of conses). int param_count = 0; Lisp_Object *pa = (Lisp_Object*) xmalloc(XFASTINT(Flength(params)) * sizeof(Lisp_Object)); while (!NILP(params)) { pa[param_count++] = CAR_SAFE(params); params = CDR_SAFE(params); } Lisp_Object ht = Fmake_hash_table(param_count, pa); I would prefer it if I could avoid all that work, but it seems (from reading lisp.h and hunting for similar code) that it must be done as above. I don't see a macro to convert a Lisp_Object that holds a list into the Lisp_Object* that a lot of functions need. Also I don't know if what xmalloc() gives needs to be freed eventually. To generate the Lisp symbol ":size" from the symbol "size" for example, I used: Lisp_Object colon = make_string (":", 1); intern(SDATA(concat2(colon, SYMBOL_NAME(head)))) I don't know if there's a better way, but this works. Thanks! Ted --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=hashprint.patch ? hashprint.patch Index: lread.c =================================================================== RCS file: /sources/emacs/emacs/src/lread.c,v retrieving revision 1.401 diff -u -r1.401 lread.c --- lread.c 7 Sep 2008 20:41:10 -0000 1.401 +++ lread.c 2 Dec 2008 20:46:34 -0000 @@ -80,6 +80,13 @@ extern int errno; #endif +/* hash table read constants */ +Lisp_Object Qhash_table_read_marker, Qhash_table_data_marker; +Lisp_Object Qhash_table_test_marker, Qhash_table_size_marker; +Lisp_Object Qhash_table_weakness_marker; +Lisp_Object Qhash_table_rehash_size_marker; +Lisp_Object Qhash_table_rehash_threshold_marker; + Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list; Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist; Lisp_Object Qascii_character, Qload, Qload_file_name; @@ -2341,6 +2348,94 @@ case '#': c = READCHAR; + if (c == 's') + { + c = READCHAR; + if (c == '(') + { + /* + Accept extended format for hashtables (extensible to + other types), e.g. + #s(hash-table size 2 test equal data (k1 v1 k2 v2)) + */ + Lisp_Object tmp = read_list (0, readcharfun); + Lisp_Object head = CAR_SAFE(tmp); + Lisp_Object data = Qnil; + Lisp_Object val = Qnil; + Lisp_Object params = Qnil; + Lisp_Object colon = make_string (":", 1); + + if (!EQ (head, Qhash_table_read_marker)) + error ("Invalid extended read marker at head of #s list" + "(only hash-table allowed)"); + + while (!NILP(tmp)) + { + tmp = CDR_SAFE(tmp); + head = CAR_SAFE(tmp); + /* allowed parameters: size test weakness + rehash-size rehash-threshold */ + if (EQ(head, Qhash_table_data_marker)) + { + tmp = CDR_SAFE(tmp); + data = CAR_SAFE(tmp); + } + + if ( + EQ(head, Qhash_table_size_marker) || + EQ(head, Qhash_table_test_marker) || + EQ(head, Qhash_table_weakness_marker) || + EQ(head, Qhash_table_rehash_size_marker) || + EQ(head, Qhash_table_rehash_threshold_marker)) + { + tmp = CDR_SAFE(tmp); + val = CAR_SAFE(tmp); + params = Fcons(val, params); + params = Fcons(intern(SDATA(concat2(colon, + SYMBOL_NAME(head)))), + params); + debug_print(params); + /* + debug_print(head); + debug_print(val); + */ + } + } + + if (NILP(data)) + error ("No data marker was found in the hash table"); + + int param_count = 0; + Lisp_Object *pa = (Lisp_Object*) xmalloc(XFASTINT(Flength(params)) * sizeof(Lisp_Object)); + + while (!NILP(params)) + { + pa[param_count++] = CAR_SAFE(params); + params = CDR_SAFE(params); + } + + Lisp_Object ht = Fmake_hash_table(param_count, pa); + + Lisp_Object key = Qnil; + + while (!NILP(data)) + { + key = CAR_SAFE(data); + data = CDR_SAFE(data); + val = CAR_SAFE(data); + data = CDR_SAFE(data); + if (NILP(val)) + error ("Odd number of elements in hashtable data"); + /* + debug_print(key); + debug_print(val); + */ + Fputhash(key, val, ht); + } + + return ht; + } + } if (c == '^') { c = READCHAR; @@ -4432,6 +4527,21 @@ Vloads_in_progress = Qnil; staticpro (&Vloads_in_progress); + + Qhash_table_read_marker = intern ("hash-table"); + staticpro (&Qhash_table_read_marker); + Qhash_table_data_marker = intern ("data"); + staticpro (&Qhash_table_data_marker); + Qhash_table_test_marker = intern ("test"); + staticpro (&Qhash_table_size_marker); + Qhash_table_test_marker = intern ("size"); + staticpro (&Qhash_table_size_marker); + Qhash_table_weakness_marker = intern ("weakness"); + staticpro (&Qhash_table_weakness_marker); + Qhash_table_rehash_size_marker = intern ("rehash-size"); + staticpro (&Qhash_table_rehash_size_marker); + Qhash_table_rehash_threshold_marker = intern ("rehash-threshold"); + staticpro (&Qhash_table_rehash_threshold_marker); } /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d Index: print.c =================================================================== RCS file: /sources/emacs/emacs/src/print.c,v retrieving revision 1.253 diff -u -r1.253 print.c --- print.c 31 Jul 2008 05:33:53 -0000 1.253 +++ print.c 2 Dec 2008 20:46:34 -0000 @@ -1341,6 +1341,7 @@ loop: if (STRINGP (obj) || CONSP (obj) || VECTORP (obj) || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) + || HASH_TABLE_P (obj) || (! NILP (Vprint_gensym) && SYMBOLP (obj) && !SYMBOL_INTERNED_P (obj))) @@ -1536,6 +1537,7 @@ /* Detect circularities and truncate them. */ if (STRINGP (obj) || CONSP (obj) || VECTORP (obj) || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) + || HASH_TABLE_P (obj) || (! NILP (Vprint_gensym) && SYMBOLP (obj) && !SYMBOL_INTERNED_P (obj))) @@ -2036,6 +2038,7 @@ else if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); +#if 0 strout ("#test)) { @@ -2052,6 +2055,68 @@ sprintf (buf, " 0x%lx", (unsigned long) h); strout (buf, -1, -1, printcharfun, 0); PRINTCHAR ('>'); +#endif + /* + implement a readable output, e.g.: + #s(hash-table size 2 test equal data (k1 v1 k2 v2)) + */ + /* always print the size */ + sprintf (buf, "#s(hash-table size %ld", (long) XVECTOR (h->next)->size); + strout (buf, -1, -1, printcharfun, 0); + + if (!NILP(h->test)) + { + strout (" test ", -1, -1, printcharfun, 0); + print_object (h->test, printcharfun, 0); + } + + if (!NILP(h->weak)) + { + strout (" weakness ", -1, -1, printcharfun, 0); + print_object (h->weak, printcharfun, 0); + } + + if (!NILP(h->rehash_size)) + { + strout (" rehash-size ", -1, -1, printcharfun, 0); + print_object (h->rehash_size, printcharfun, 0); + } + + if (!NILP(h->rehash_threshold)) + { + strout (" rehash-threshold ", -1, -1, printcharfun, 0); + print_object (h->rehash_threshold, printcharfun, 0); + } + + strout (" data ", -1, -1, printcharfun, 0); + + /* print the data here as a plist */ + int i; + + int real_size = HASH_TABLE_SIZE (h); + int size = real_size; + + /* Don't print more elements than the specified maximum. */ + if (NATNUMP (Vprint_length) + && XFASTINT (Vprint_length) < size) + size = XFASTINT (Vprint_length); + + PRINTCHAR ('('); + for (i = 0; i < size; i++) + if (!NILP (HASH_HASH (h, i))) + { + if (i) PRINTCHAR (' '); + print_object (HASH_KEY (h, i), printcharfun, 0); + PRINTCHAR (' '); + print_object (HASH_VALUE (h, i), printcharfun, 0); + } + + if (size < real_size) + strout (" ...", 4, 4, printcharfun, 0); + + PRINTCHAR (')'); + PRINTCHAR (')'); + } else if (BUFFERP (obj)) { --=-=-=--