? 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 1 Dec 2008 21:48:58 -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,89 @@ 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; + /* will this be freed automatically? */ + Lisp_Object* params = (Lisp_Object*) xmalloc (10 * sizeof(Lisp_Object)); + int param_count = 0; + 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); + /* debug_print(data); */ + } + + if ( + param_count < 9 && + 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); + /* + debug_print(head); + debug_print(val); + */ + /* how do I turn head into a symbol with the same contents but beginning with ':'? */ + params[param_count] = head; + params[param_count+1] = val; + param_count+=2; + } + } + + if (NILP(data)) + error ("No data marker was found in the hash table"); + + /* doesn't work because of 'size' vs. ':size' issue, see above + Lisp_Object ht = Fmake_hash_table(param_count, params); + */ + Lisp_Object ht = Fmake_hash_table(0, NULL); + + 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 +4522,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 1 Dec 2008 21:48:58 -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,61 @@ 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 printed=0; + + PRINTCHAR ('('); + for (i = 0; i < HASH_TABLE_SIZE (h); ++i) + if (!NILP (HASH_HASH (h, i))) + { + if (printed) + { + PRINTCHAR (' '); + } + print_object (HASH_KEY (h, i), printcharfun, 0); + PRINTCHAR (' '); + print_object (HASH_VALUE (h, i), printcharfun, 0); + printed = 1; + } + PRINTCHAR (')'); + PRINTCHAR (')'); + } else if (BUFFERP (obj)) {