? hashprint.patch
Index: lread.c
===================================================================
RCS file: /sources/emacs/emacs/src/lread.c,v
retrieving revision 1.406
diff -c -r1.406 lread.c
*** lread.c	29 Apr 2009 03:03:00 -0000	1.406
--- lread.c	31 Jul 2009 18:09:25 -0000
***************
*** 80,85 ****
--- 80,93 ----
  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,2346 ****
--- 2349,2426 ----
  
      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;
***************
*** 4436,4441 ****
--- 4516,4536 ----
  
    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.256
diff -c -r1.256 print.c
*** print.c	3 Apr 2009 06:23:49 -0000	1.256
--- print.c	31 Jul 2009 18:09:25 -0000
***************
*** 1341,1346 ****
--- 1341,1347 ----
   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,1541 ****
--- 1537,1543 ----
    /* 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,2036 ****
--- 2033,2039 ----
        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,2052 ****
--- 2050,2116 ----
  	  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,2359 ****
--- 2418,2425 ----
    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'.  */);