From f19a0f5b11e41baf46ce11fd447744ceb97ef754 Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Wed, 5 Aug 2009 09:19:21 +0000 Subject: [PATCH] * lread.c (read1, syms_of_lread): Read hashtables back from the readable format. * print.c (print_preprocess, print_object): Print hashtables fully and readably. (syms_of_print): Provide 'hashtable-print-readable. --- src/ChangeLog | 9 +++++ src/lread.c | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++ src/print.c | 66 +++++++++++++++++++++++++++++++++++ 3 files changed, 170 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index a33144b7a3..0a0973635d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2009-08-05 Teodor Zlatanov + + * lread.c (read1, syms_of_lread): Read hashtables back from the + readable format. + + * print.c (print_preprocess, print_object): Print hashtables fully + and readably. + (syms_of_print): Provide 'hashtable-print-readable. + 2009-08-02 Adrian Robert * nsfont.m (ns_descriptor_to_entity): Handle case when descriptor has diff --git a/src/lread.c b/src/lread.c index 0fb93031ad..193bd6ae66 100644 --- a/src/lread.c +++ b/src/lread.c @@ -80,6 +80,14 @@ along with GNU Emacs. If not, see . */ extern int errno; #endif +/* hash table read constants */ +Lisp_Object Qhash_table, Qdata; +Lisp_Object Qtest, Qsize; +Lisp_Object Qweakness; +Lisp_Object Qrehash_size; +Lisp_Object Qrehash_threshold; +extern Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; + 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; @@ -2346,6 +2354,78 @@ read1 (readcharfun, pch, first_in_list) 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; + /* The size is 2 * number of allowed keywords to + make-hash-table. */ + Lisp_Object params[10]; + Lisp_Object ht; + Lisp_Object key = Qnil; + int param_count = 0; + int i; + + if (!EQ (head, Qhash_table)) + error ("Invalid extended read marker at head of #s list " + "(only hash-table allowed)"); + + tmp = CDR_SAFE (tmp); + + /* This is repetitive but fast and simple. */ + params[param_count] = QCsize; + params[param_count+1] = Fplist_get (tmp, Qsize); + if (!NILP (params[param_count+1])) + param_count+=2; + + params[param_count] = QCtest; + params[param_count+1] = Fplist_get (tmp, Qtest); + if (!NILP (params[param_count+1])) + param_count+=2; + + params[param_count] = QCweakness; + params[param_count+1] = Fplist_get (tmp, Qweakness); + if (!NILP (params[param_count+1])) + param_count+=2; + + params[param_count] = QCrehash_size; + params[param_count+1] = Fplist_get (tmp, Qrehash_size); + if (!NILP (params[param_count+1])) + param_count+=2; + + params[param_count] = QCrehash_threshold; + params[param_count+1] = Fplist_get (tmp, Qrehash_threshold); + if (!NILP (params[param_count+1])) + param_count+=2; + + /* This is the hashtable data. */ + data = Fplist_get (tmp, Qdata); + + /* Now use params to make a new hashtable and fill it. */ + ht = Fmake_hash_table (param_count, params); + + while (CONSP (data)) + { + key = XCAR (data); + data = XCDR (data); + if (!CONSP (data)) + error ("Odd number of elements in hashtable data"); + val = XCAR (data); + data = XCDR (data); + Fputhash (key, val, ht); + } + + return ht; + } + } if (c == '^') { c = READCHAR; @@ -4448,6 +4528,21 @@ to load. See also `load-dangerous-libraries'. */); Vloads_in_progress = Qnil; staticpro (&Vloads_in_progress); + + Qhash_table = intern ("hash-table"); + staticpro (&Qhash_table); + Qdata = intern ("data"); + staticpro (&Qdata); + Qtest = intern ("test"); + staticpro (&Qtest); + Qsize = intern ("size"); + staticpro (&Qsize); + Qweakness = intern ("weakness"); + staticpro (&Qweakness); + Qrehash_size = intern ("rehash-size"); + staticpro (&Qrehash_size); + Qrehash_threshold = intern ("rehash-threshold"); + staticpro (&Qrehash_threshold); } /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d diff --git a/src/print.c b/src/print.c index e78f593c7b..ce63b63acd 100644 --- a/src/print.c +++ b/src/print.c @@ -1341,6 +1341,7 @@ print_preprocess (obj) 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 @@ print_object (obj, printcharfun, escapeflag) /* 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))) @@ -2031,6 +2033,7 @@ print_object (obj, printcharfun, escapeflag) else if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); +#if 0 strout ("#test)) { @@ -2047,6 +2050,67 @@ print_object (obj, printcharfun, escapeflag) 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)) { @@ -2354,6 +2418,8 @@ that represents the number without losing information. */); Qfloat_output_format = intern ("float-output-format"); staticpro (&Qfloat_output_format); + Fprovide (intern ("hashtable-print-readable"), Qnil); + DEFVAR_LISP ("print-length", &Vprint_length, doc: /* Maximum length of list to print before abbreviating. A value of nil means no limit. See also `eval-expression-print-length'. */); -- 2.20.1