* 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.

diff --git a/src/ChangeLog b/src/ChangeLog
index a33144b7a336927ae91d9d2506dcdf82de7ef298..0a0973635dde3c37389950d11c48cb5c2218aa21 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2009-08-05  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * 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  <Adrian.B.Robert@gmail.com>
 
        * nsfont.m (ns_descriptor_to_entity): Handle case when descriptor has

diff --git a/src/lread.c b/src/lread.c
index 0fb93031ad484358f4f87d0e5c62d83cca05c654..193bd6ae6683d6988eb2d3dd68d5c05f9a509d77 100644 (file)
--- a/src/lread.c
+++ b/src/lread.c
@@ -80,6 +80,14 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 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 e78f593c7b51c1c181dca122c178a9fe8f8f1884..ce63b63acd3b836cc1327c3a26f56f3a03354a71 100644 (file)
--- 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 ("#<hash-table", -1, -1, printcharfun, 0);
          if (SYMBOLP (h->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'.  */);