From 278a6e1916cd78a405501ac0431f1b90cdb6cfaf Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 25 Nov 2023 17:36:53 +0100 Subject: [PATCH] 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 ("#', 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 ("#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, "#", 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 ("#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 ("#', 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 ("#", 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 ("#', printcharfun); - break; + return; case PVEC_MUTEX: print_c_string ("#', printcharfun); - break; + return; case PVEC_CONDVAR: print_c_string ("#', printcharfun); - break; + return; -#ifdef HAVE_MODULES case PVEC_MODULE_FUNCTION: +#ifdef HAVE_MODULES { print_c_string ("#', 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 ("#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 ("#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 # or #. */ print_c_string ("#", 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 ("#", 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 ("#"), - printcharfun); - break; - } + emacs_abort (); } print_depth--; -- 2.39.5