Refactor pseudovector printing

* src/print.c (print_vectorlike): Split into...
(print_bignum, print_bool_vector, print_vectorlike_unreadable):
...these functions.  Exhaustive switch on pseudovector type.
Remove unused return value.
(print_object): Use new functions and simplify.

1 files changed, 134 insertions, 135 deletions

diff --git a/src/print.c b/src/print.c
index 4eee8319f65..a5d57adbd3b 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1599,76 +1599,69 @@ print_pointer (Lisp_Object printcharfun, char *buf, const char *prefix,
 }
 #endif
 
-static bool
-print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
-		  char *buf)
+static void
+print_bignum (Lisp_Object obj, Lisp_Object printcharfun)
 {
-  /* First do all the vectorlike types that have a readable syntax.  */
-  switch (PSEUDOVECTOR_TYPE (XVECTOR (obj)))
-    {
-    case PVEC_BIGNUM:
-      {
-	ptrdiff_t size = bignum_bufsize (obj, 10);
-	USE_SAFE_ALLOCA;
-	char *str = SAFE_ALLOCA (size);
-	ptrdiff_t len = bignum_to_c_string (str, size, obj, 10);
-	strout (str, len, len, printcharfun);
-	SAFE_FREE ();
-      }
-      return true;
-
-    case PVEC_BOOL_VECTOR:
-      {
-	EMACS_INT size = bool_vector_size (obj);
-	ptrdiff_t size_in_bytes = bool_vector_bytes (size);
-	ptrdiff_t real_size_in_bytes = size_in_bytes;
-	unsigned char *data = bool_vector_uchar_data (obj);
-
-	int len = sprintf (buf, "#&%"pI"d\"", size);
-	strout (buf, len, len, printcharfun);
+  ptrdiff_t size = bignum_bufsize (obj, 10);
+  USE_SAFE_ALLOCA;
+  char *str = SAFE_ALLOCA (size);
+  ptrdiff_t len = bignum_to_c_string (str, size, obj, 10);
+  strout (str, len, len, printcharfun);
+  SAFE_FREE ();
+}
 
-	/* Don't print more bytes than the specified maximum.
-	   Negative values of print-length are invalid.  Treat them
-	   like a print-length of nil.  */
-	if (FIXNATP (Vprint_length)
-	    && XFIXNAT (Vprint_length) < size_in_bytes)
-	  size_in_bytes = XFIXNAT (Vprint_length);
+static void
+print_bool_vector (Lisp_Object obj, Lisp_Object printcharfun)
+{
+  EMACS_INT size = bool_vector_size (obj);
+  ptrdiff_t size_in_bytes = bool_vector_bytes (size);
+  ptrdiff_t real_size_in_bytes = size_in_bytes;
+  unsigned char *data = bool_vector_uchar_data (obj);
 
-	for (ptrdiff_t i = 0; i < size_in_bytes; i++)
-	  {
-	    maybe_quit ();
-	    unsigned char c = data[i];
-	    if (c == '\n' && print_escape_newlines)
-	      print_c_string ("\\n", printcharfun);
-	    else if (c == '\f' && print_escape_newlines)
-	      print_c_string ("\\f", printcharfun);
-	    else if (c > '\177'
-		     || (print_escape_control_characters && c_iscntrl (c)))
-	      {
-		/* Use octal escapes to avoid encoding issues.  */
-		octalout (c, data, i + 1, size_in_bytes, printcharfun);
-	      }
-	    else
-	      {
-		if (c == '\"' || c == '\\')
-		  printchar ('\\', printcharfun);
-		printchar (c, printcharfun);
-	      }
-	  }
+  char buf[sizeof "#&" + INT_STRLEN_BOUND (ptrdiff_t)];
+  int len = sprintf (buf, "#&%"pI"d\"", size);
+  strout (buf, len, len, printcharfun);
 
-	if (size_in_bytes < real_size_in_bytes)
-	  print_c_string (" ...", printcharfun);
-	printchar ('\"', printcharfun);
-      }
-      return true;
+  /* Don't print more bytes than the specified maximum.
+     Negative values of print-length are invalid.  Treat them
+     like a print-length of nil.  */
+  if (FIXNATP (Vprint_length)
+      && XFIXNAT (Vprint_length) < size_in_bytes)
+    size_in_bytes = XFIXNAT (Vprint_length);
 
-    default:
-      break;
+  for (ptrdiff_t i = 0; i < size_in_bytes; i++)
+    {
+      maybe_quit ();
+      unsigned char c = data[i];
+      if (c == '\n' && print_escape_newlines)
+	print_c_string ("\\n", printcharfun);
+      else if (c == '\f' && print_escape_newlines)
+	print_c_string ("\\f", printcharfun);
+      else if (c > '\177'
+	       || (print_escape_control_characters && c_iscntrl (c)))
+	{
+	  /* Use octal escapes to avoid encoding issues.  */
+	  octalout (c, data, i + 1, size_in_bytes, printcharfun);
+	}
+      else
+	{
+	  if (c == '\"' || c == '\\')
+	    printchar ('\\', printcharfun);
+	  printchar (c, printcharfun);
+	}
     }
 
-  /* Then do all the pseudovector types that don't have a readable
-     syntax.  First check whether this is handled by
-     `print-unreadable-function'.  */
+  if (size_in_bytes < real_size_in_bytes)
+    print_c_string (" ...", printcharfun);
+  printchar ('\"', printcharfun);
+}
+
+/* Print a pseudovector that has no readable syntax.  */
+static void
+print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun,
+			     bool escapeflag, char *buf)
+{
+  /* First check whether this is handled by `print-unreadable-function'.  */
   if (!NILP (Vprint_unreadable_function)
       && FUNCTIONP (Vprint_unreadable_function))
     {
@@ -1697,7 +1690,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	  if (STRINGP (result))
 	    print_string (result, printcharfun);
 	  /* It's handled, so stop processing here.  */
-	  return true;
+	  return;
 	}
     }
 
@@ -1718,7 +1711,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	  print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun);
 	}
       printchar ('>', printcharfun);
-      break;
+      return;
 
     case PVEC_SYMBOL_WITH_POS:
       {
@@ -1742,7 +1735,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
             printchar ('>', printcharfun);
           }
       }
-      break;
+      return;
 
     case PVEC_OVERLAY:
       print_c_string ("#<overlay ", printcharfun);
@@ -1758,7 +1751,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 			printcharfun);
 	}
       printchar ('>', printcharfun);
-      break;
+      return;
 
     case PVEC_USER_PTR:
       {
@@ -1769,14 +1762,14 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	strout (buf, i, i, printcharfun);
 	printchar ('>', printcharfun);
       }
-      break;
+      return;
 
     case PVEC_FINALIZER:
       print_c_string ("#<finalizer", printcharfun);
       if (NILP (XFINALIZER (obj)->function))
 	print_c_string (" used", printcharfun);
       printchar ('>', printcharfun);
-      break;
+      return;
 
     case PVEC_MISC_PTR:
       {
@@ -1785,7 +1778,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	int i = sprintf (buf, "#<ptr %p>", xmint_pointer (obj));
 	strout (buf, i, i, printcharfun);
       }
-      break;
+      return;
 
     case PVEC_PROCESS:
       if (escapeflag)
@@ -1796,13 +1789,13 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	}
       else
 	print_string (XPROCESS (obj)->name, printcharfun);
-      break;
+      return;
 
     case PVEC_SUBR:
       print_c_string ("#<subr ", printcharfun);
       print_c_string (XSUBR (obj)->symbol_name, printcharfun);
       printchar ('>', printcharfun);
-      break;
+      return;
 
     case PVEC_XWIDGET:
 #ifdef HAVE_XWIDGETS
@@ -1822,15 +1815,15 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 #endif
 	    strout (buf, len, len, printcharfun);
 	  }
-	break;
+	return;
       }
-#else
-      emacs_abort ();
 #endif
+      break;
+
     case PVEC_XWIDGET_VIEW:
       print_c_string ("#<xwidget view", printcharfun);
       printchar ('>', printcharfun);
-      break;
+      return;
 
     case PVEC_WINDOW:
       {
@@ -1845,7 +1838,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	  }
 	printchar ('>', printcharfun);
       }
-      break;
+      return;
 
     case PVEC_TERMINAL:
       {
@@ -1859,7 +1852,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	  }
 	printchar ('>', printcharfun);
       }
-      break;
+      return;
 
     case PVEC_BUFFER:
       if (!BUFFER_LIVE_P (XBUFFER (obj)))
@@ -1872,11 +1865,11 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	}
       else
 	print_string (BVAR (XBUFFER (obj), name), printcharfun);
-      break;
+      return;
 
     case PVEC_WINDOW_CONFIGURATION:
       print_c_string ("#<window-configuration>", printcharfun);
-      break;
+      return;
 
     case PVEC_FRAME:
       {
@@ -1900,7 +1893,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	int len = sprintf (buf, " %p>", ptr);
 	strout (buf, len, len, printcharfun);
       }
-      break;
+      return;
 
     case PVEC_FONT:
       {
@@ -1933,7 +1926,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	  }
 	printchar ('>', printcharfun);
       }
-      break;
+      return;
 
     case PVEC_THREAD:
       print_c_string ("#<thread ", printcharfun);
@@ -1946,7 +1939,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	  strout (buf, len, len, printcharfun);
 	}
       printchar ('>', printcharfun);
-      break;
+      return;
 
     case PVEC_MUTEX:
       print_c_string ("#<mutex ", printcharfun);
@@ -1959,7 +1952,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	  strout (buf, len, len, printcharfun);
 	}
       printchar ('>', printcharfun);
-      break;
+      return;
 
     case PVEC_CONDVAR:
       print_c_string ("#<condvar ", printcharfun);
@@ -1972,10 +1965,10 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	  strout (buf, len, len, printcharfun);
 	}
       printchar ('>', printcharfun);
-      break;
+      return;
 
-#ifdef HAVE_MODULES
     case PVEC_MODULE_FUNCTION:
+#ifdef HAVE_MODULES
       {
 	print_c_string ("#<module function ", printcharfun);
         const struct Lisp_Module_Function *function = XMODULE_FUNCTION (obj);
@@ -2000,11 +1993,13 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	  }
 
 	printchar ('>', printcharfun);
+	return;
       }
-      break;
 #endif
-#ifdef HAVE_NATIVE_COMP
+      break;
+
     case PVEC_NATIVE_COMP_UNIT:
+#ifdef HAVE_NATIVE_COMP
       {
 	struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (obj);
 	print_c_string ("#<native compilation unit: ", printcharfun);
@@ -2012,27 +2007,32 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	printchar (' ', printcharfun);
 	print_object (cu->optimize_qualities, printcharfun, escapeflag);
 	printchar ('>', printcharfun);
+	return;
       }
-      break;
 #endif
+      break;
 
-#ifdef HAVE_TREE_SITTER
     case PVEC_TS_PARSER:
+#ifdef HAVE_TREE_SITTER
       print_c_string ("#<treesit-parser for ", printcharfun);
       Lisp_Object language = XTS_PARSER (obj)->language_symbol;
       /* No need to print the buffer because it's not that useful: we
 	 usually know which buffer a parser belongs to.  */
       print_string (Fsymbol_name (language), printcharfun);
       printchar ('>', printcharfun);
+      return;
+#endif
       break;
+
     case PVEC_TS_NODE:
+#ifdef HAVE_TREE_SITTER
       /* Prints #<treesit-node (identifier) in 12-15> or
          #<treesit-node "keyword" in 28-31>. */
       print_c_string ("#<treesit-node", printcharfun);
       if (!treesit_node_uptodate_p (obj))
 	{
 	  print_c_string ("-outdated>", printcharfun);
-	  break;
+	  return;
 	}
       printchar (' ', printcharfun);
       /* Now the node must be up-to-date, and calling functions like
@@ -2053,11 +2053,16 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
       printchar ('-', printcharfun);
       print_object (Ftreesit_node_end (obj), printcharfun, escapeflag);
       printchar ('>', printcharfun);
+      return;
+#endif
       break;
+
     case PVEC_TS_COMPILED_QUERY:
+#ifdef HAVE_TREE_SITTER
       print_c_string ("#<treesit-compiled-query>", printcharfun);
-      break;
+      return;
 #endif
+      break;
 
     case PVEC_SQLITE:
       {
@@ -2073,13 +2078,23 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
 	print_c_string (XSQLITE (obj)->name, printcharfun);
 	printchar ('>', printcharfun);
       }
-      break;
+      return;
 
-    default:
-      emacs_abort ();
+    /* Types handled earlier.  */
+    case PVEC_NORMAL_VECTOR:
+    case PVEC_RECORD:
+    case PVEC_COMPILED:
+    case PVEC_CHAR_TABLE:
+    case PVEC_SUB_CHAR_TABLE:
+    case PVEC_HASH_TABLE:
+    case PVEC_BIGNUM:
+    case PVEC_BOOL_VECTOR:
+    /* Impossible cases.  */
+    case PVEC_FREE:
+    case PVEC_OTHER:
+      break;
     }
-
-  return true;
+  emacs_abort ();
 }
 
 static char
@@ -2523,29 +2538,21 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
       switch (PSEUDOVECTOR_TYPE (XVECTOR (obj)))
 	{
 	case PVEC_NORMAL_VECTOR:
-	  {
-	    print_stack_push_vector ("[", "]", obj, 0, ASIZE (obj),
-				     printcharfun);
-	    goto next_obj;
-	  }
+	  print_stack_push_vector ("[", "]", obj, 0, ASIZE (obj),
+				   printcharfun);
+	  goto next_obj;
 	case PVEC_RECORD:
-	  {
-	    print_stack_push_vector ("#s(", ")", obj, 0, PVSIZE (obj),
-				     printcharfun);
-	    goto next_obj;
-	  }
+	  print_stack_push_vector ("#s(", ")", obj, 0, PVSIZE (obj),
+				   printcharfun);
+	  goto next_obj;
 	case PVEC_COMPILED:
-	  {
-	    print_stack_push_vector ("#[", "]", obj, 0, PVSIZE (obj),
-				     printcharfun);
-	    goto next_obj;
-	  }
+	  print_stack_push_vector ("#[", "]", obj, 0, PVSIZE (obj),
+				   printcharfun);
+	  goto next_obj;
 	case PVEC_CHAR_TABLE:
-	  {
-	    print_stack_push_vector ("#^[", "]", obj, 0, PVSIZE (obj),
-				     printcharfun);
-	    goto next_obj;
-	  }
+	  print_stack_push_vector ("#^[", "]", obj, 0, PVSIZE (obj),
+				   printcharfun);
+	  goto next_obj;
 	case PVEC_SUB_CHAR_TABLE:
 	  {
 	    /* Make each lowest sub_char_table start a new line.
@@ -2614,30 +2621,22 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 	    goto next_obj;
 	  }
 
+	case PVEC_BIGNUM:
+	  print_bignum (obj, printcharfun);
+	  break;
+
+	case PVEC_BOOL_VECTOR:
+	  print_bool_vector (obj, printcharfun);
+	  break;
+
 	default:
+	  print_vectorlike_unreadable (obj, printcharfun, escapeflag, buf);
 	  break;
 	}
-
-      if (print_vectorlike (obj, printcharfun, escapeflag, buf))
 	break;
-      FALLTHROUGH;
 
     default:
-      {
-	int len;
-	/* We're in trouble if this happens!
-	   Probably should just emacs_abort ().	 */
-	print_c_string ("#<EMACS BUG: INVALID DATATYPE ", printcharfun);
-	if (VECTORLIKEP (obj))
-	  len = sprintf (buf, "(PVEC 0x%08zx)", (size_t) ASIZE (obj));
-	else
-	  len = sprintf (buf, "(0x%02x)", (unsigned) XTYPE (obj));
-	strout (buf, len, len, printcharfun);
-	print_c_string ((" Save your buffers immediately"
-			 " and please report this bug>"),
-			printcharfun);
-	break;
-      }
+      emacs_abort ();
     }
   print_depth--;