Re: hash-table-{to, from}-alist

[Ted Zlatanov <tzz@lifelogs.com>]

[-- Attachment #1: Type: text/plain, Size: 1987 bytes --]

On Wed, 26 Nov 2008 15:16:41 -0600 Ted Zlatanov <tzz@lifelogs.com> wrote: 

TZ> The patch below does all the previously discussed formatting plus
TZ> detection of circular references and Davis Herring's suggestion of
TZ> skipping the first preliminary space.  The old-style hashtable printout
TZ> is disabled with an #ifdef, so only the new style is available.

The attached patch does reading and writing of hashtables.  I believe
it works correctly and handles the common error cases.  Please review.

Here are the issues:

- I don't know how to manage a dynamic array of Lisp_Object objects, as
  make-hash-table wants.  What I have right now is hacky and breaks for
  more than 5 parameters (e.g. reading #s(hash-table size 4 size 5 size
  4 size 5 size 4 weakness x) will ignore the weakness parameter.
  Ideally I'd put the arguments in a list and pass that off to
  make-hash-table, but I couldn't find an example of that in the source
  (casting a list of an array of Lisp_Object elements).  Additionally I
  use xmalloc without freeing the memory; I don't know if that will
  cause issues but I saw it used in other places without freeing the
  memory.

- it seems to me that
		      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))
  can be written better, but I don't know enough to do it right.  In
  addition, I don't know how to convert all those parameters to their :
  plist version, e.g. size => :size.  I'm sure it's trivial but couldn't
  find it in the source.  I really wish I could write all this in ELisp :)

- my code is very deliberate, using CAR_SAFE and CDR_SAFE a lot.  If
  that causes performance issues, please suggest improvements.  Ditto
  for anything else--remember this is my first trip to the C side of
  Emacs and treat everything with suspicion.

Thanks
Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: hashprint.patch --]
[-- Type: text/x-diff, Size: 6766 bytes --]

? 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 ("#<hash-table", -1, -1, printcharfun, 0);
 	  if (SYMBOLP (h->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))
 	{