[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 278a6e1916c 2/2: Refactor pseudovector printing
|
From: |
Mattias Engdegård |
|
Subject: |
master 278a6e1916c 2/2: Refactor pseudovector printing |
|
Date: |
Sat, 25 Nov 2023 13:00:38 -0500 (EST) |
branch: master
commit 278a6e1916cd78a405501ac0431f1b90cdb6cfaf
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
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.
---
src/print.c | 269 ++++++++++++++++++++++++++++++------------------------------
1 file 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--;