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

[Ted Zlatanov <tzz@lifelogs.com>]

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

On Wed, 03 Dec 2008 21:05:54 -0500 Stefan Monnier <monnier@iro.umontreal.ca> wrote: 

>> I took your other suggestions, except I don't pass Qnil parameters to
>> make-hash-table to keep things clean.  I hope this version of the patch
>> is acceptable.

SM> Some nitpicks, see below.
SM> BTW, have you tried to delegate to some Elisp code?

Why at this point?  The C code is written, is there a problem with it?

SM> We like to avoid putting comment markers on their own line.  We like
SM> to terminate our comments like sentences: with a [d]ot followed by 2
SM> spaces.  We like to put the body of the `if' on a separate line.
SM> Comments should be capitalized.

All these are fixed, thanks for pointing them out.

>> +	      Lisp_Object ht = Fmake_hash_table (param_count, params);
>> +	      Lisp_Object key = Qnil;

SM> We recently decided it was OK to use ANSI C syntax for function headers,
SM> but I don't think ANSI C allows such variable declarations in the middle
SM> of a block.  So we should probably move the delcaration of those 2 vars
SM> higher up, or open up a new block.

Fixed.  Revised patch attached.

Thanks
Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: hashprint.patch --]
[-- Type: text/x-diff, Size: 6615 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	4 Dec 2008 15:02:39 -0000
@@ -80,6 +80,14 @@
 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;
@@ -2341,6 +2349,78 @@
 
     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;
@@ -4432,6 +4512,21 @@
 
   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
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	4 Dec 2008 15:02:39 -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,67 @@
 	  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))
 	{