procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactor pseudovector printing

Browse source 
* 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.
This commit is contained in:
Mattias Engdegård 2023-11-25 17:36:53 +01:00
parent f8fe0cf1bb
commit 278a6e1916
1 changed files with 140 additions and 141 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

281
src/print.c
View file

@ -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)))
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 ();
}
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);
char buf[sizeof "#&" + INT_STRLEN_BOUND (ptrdiff_t)];
int len = sprintf (buf, "#&%"pI"d\"", size);
strout (buf, len, len, printcharfun);
/* 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);
for (ptrdiff_t i = 0; i < size_in_bytes; i++)
{
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);
/* 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);
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);
}
}
if (size_in_bytes < real_size_in_bytes)
print_c_string (" ...", printcharfun);
printchar ('\"', printcharfun);
}
return true;
default:
break;
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);
break;
case PVEC_TS_COMPILED_QUERY:
print_c_string ("#<treesit-compiled-query>", printcharfun);
break;
return;
#endif
break;
case PVEC_TS_COMPILED_QUERY:
#ifdef HAVE_TREE_SITTER
print_c_string ("#<treesit-compiled-query>", printcharfun);
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);
}
return;
/* 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;
default:
emacs_abort ();
}
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--;