Speed up (format "%s" STRING) and the like

Although the Lisp manual said that ‘format’ returns a
newly-allocated string, this was not true for a few cases like
(format "%s" ""), and fixing the documentation to allow reuse of
arguments lets us improve performance in common cases like
(format "foo") and (format "%s" "foo") (Bug#28625).
* doc/lispref/strings.texi (Formatting Strings):
* etc/NEWS:
Say that the result of ‘format’ might not be newly allocated.
* src/callint.c (Fcall_interactively):
* src/dbusbind.c (XD_OBJECT_TO_STRING):
* src/editfns.c (Fmessage, Fmessage_box):
* src/xdisp.c (vadd_to_log, Ftrace_to_stderr):
Just use Fformat or Fformat_message, as that’s simpler and no
longer makes unnecessary copies.
* src/editfns.c (styled_format): Remove last argument, as it
is no longer needed: all callers now want it to behave as if it
were true.  All remaining callers changed.  Make this function
static again.  Simplify the function now that we no longer
need to worry about whether the optimization is allowed.

diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index dd004927caf340e23fe77a6f014c3130584f1365..09c3bdf71f634886d1d70ac08a46f8d0ed03e597 100644 (file)
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -812,15 +812,19 @@ formatting feature described here; they differ from @code{format-message} only
 in how they use the result of formatting.
 
 @defun format string &rest objects
-This function returns a new string that is made by copying
-@var{string} and then replacing any format specification
-in the copy with encodings of the corresponding @var{objects}.  The
+This function returns a string equal to @var{string}, replacing any format
+specifications with encodings of the corresponding @var{objects}.  The
 arguments @var{objects} are the computed values to be formatted.
 
 The characters in @var{string}, other than the format specifications,
 are copied directly into the output, including their text properties,
 if any.  Any text properties of the format specifications are copied
 to the produced string representations of the argument @var{objects}.
+
+The output string need not be newly-allocated.  For example, if
+@code{x} is the string @code{"foo"}, the expressions @code{(eq x
+(format x))} and @code{(eq x (format "%s" x))} might both yield
+@code{t}.
 @end defun
 
 @defun format-message string &rest objects

diff --git a/etc/NEWS b/etc/NEWS
index 62d2450f9a3385729eb9f74f20f4c7323d057d07..62a9ea2181cacfffcf34ae8b21a7972b6ca21350 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1556,6 +1556,13 @@ Emacs integers with %e, %f, or %g conversions.  For example, on these
 hosts (eql N (string-to-number (format "%.0f" N))) now returns t for
 all Emacs integers N.
 
++++
+** 'format' is no longer documented to return a newly-allocated string.
+This documentation was not correct, as (eq x (format x)) returned t
+when x was the empty string.  'format' now takes advantage of the doc
+change to avoid making copies of strings in common cases like (format
+"foo") and (format "%s" "foo").
+
 ---
 ** Calls that accept floating-point integers (for use on hosts with
 limited integer range) now signal an error if arguments are not

diff --git a/src/callint.c b/src/callint.c
index 469205cc380dcc1774a63ba7e20487d898796720..5d88082e38d87e365f5fb275fdec0f6143756430 100644 (file)
--- a/src/callint.c
+++ b/src/callint.c
@@ -272,7 +272,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
 {
   /* `args' will contain the array of arguments to pass to the function.
      `visargs' will contain the same list but in a nicer form, so that if we
-     pass it to styled_format it will be understandable to a human.  */
+     pass it to Fformat_message it will be understandable to a human.  */
   Lisp_Object *args, *visargs;
   Lisp_Object specs;
   Lisp_Object filter_specs;
@@ -502,7 +502,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
   for (i = 2; *tem; i++)
     {
       visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n"));
-      callint_message = styled_format (i - 1, visargs + 1, true, false);
+      callint_message = Fformat_message (i - 1, visargs + 1);
 
       switch (*tem)
        {

diff --git a/src/dbusbind.c b/src/dbusbind.c
index 789aa008611a55d39ebb0e3a315b41632d5414cf..4a7068416fe11490ea5b6d9b09a760608d57bd53 100644 (file)
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -237,8 +237,7 @@ static char *
 XD_OBJECT_TO_STRING (Lisp_Object object)
 {
   AUTO_STRING (format, "%s");
-  Lisp_Object args[] = { format, object };
-  return SSDATA (styled_format (ARRAYELTS (args), args, false, false));
+  return SSDATA (CALLN (Fformat, format, object));
 }
 
 #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus)                              \

diff --git a/src/editfns.c b/src/editfns.c
index e326604467cb59692527b584a4aea239faab3062..d88a913c667da2f38dbcb4b691125acc0968cab5 100644 (file)
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -74,6 +74,7 @@ static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec,
 static long int tm_gmtoff (struct tm *);
 static int tm_diff (struct tm *, struct tm *);
 static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
+static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool);
 
 #ifndef HAVE_TM_GMTOFF
 # define HAVE_TM_GMTOFF false
@@ -3958,7 +3959,7 @@ usage: (message FORMAT-STRING &rest ARGS)  */)
     }
   else
     {
-      Lisp_Object val = styled_format (nargs, args, true, false);
+      Lisp_Object val = Fformat_message (nargs, args);
       message3 (val);
       return val;
     }
@@ -3984,7 +3985,7 @@ usage: (message-box FORMAT-STRING &rest ARGS)  */)
     }
   else
     {
-      Lisp_Object val = styled_format (nargs, args, true, false);
+      Lisp_Object val = Fformat_message (nargs, args);
       Lisp_Object pane, menu;
 
       pane = list1 (Fcons (build_string ("OK"), Qt));
@@ -4140,7 +4141,7 @@ produced text.
 usage: (format STRING &rest OBJECTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return styled_format (nargs, args, false, true);
+  return styled_format (nargs, args, false);
 }
 
 DEFUN ("format-message", Fformat_message, Sformat_message, 1, MANY, 0,
@@ -4156,16 +4157,13 @@ and right quote replacement characters are specified by
 usage: (format-message STRING &rest OBJECTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  return styled_format (nargs, args, true, true);
+  return styled_format (nargs, args, true);
 }
 
-/* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise.
-   If NEW_RESULT, the result is a new string; otherwise, the result
-   may be one of the arguments.  */
+/* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise.  */
 
-Lisp_Object
-styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
-              bool new_result)
+static Lisp_Object
+styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
 {
   ptrdiff_t n;         /* The number of the next arg to substitute.  */
   char initial_buffer[4000];
@@ -4195,9 +4193,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
     /* The start and end bytepos in the output string.  */
     ptrdiff_t start, end;
 
-    /* Whether the argument is a newly created string.  */
-    bool_bf new_string : 1;
-
     /* Whether the argument is a string with intervals.  */
     bool_bf intervals : 1;
   } *info;
@@ -4241,6 +4236,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
   ptrdiff_t ispec;
   ptrdiff_t nspec = 0;
 
+  /* True if a string needs to be allocated to hold the result.  */
+  bool new_result = false;
+
   /* If we start out planning a unibyte result,
      then discover it has to be multibyte, we jump back to retry.  */
  retry:
@@ -4360,7 +4358,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
          if (nspec < ispec)
            {
              spec->argument = args[n];
-             spec->new_string = false;
              spec->intervals = false;
              nspec = ispec;
            }
@@ -4378,7 +4375,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
                {
                  Lisp_Object noescape = conversion == 'S' ? Qnil : Qt;
                  spec->argument = arg = Fprin1_to_string (arg, noescape);
-                 spec->new_string = true;
                  if (STRING_MULTIBYTE (arg) && ! multibyte)
                    {
                      multibyte = true;
@@ -4397,7 +4393,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
                      goto retry;
                    }
                  spec->argument = arg = Fchar_to_string (arg);
-                 spec->new_string = true;
                }
 
              if (!EQ (arg, args[n]))
@@ -4421,7 +4416,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
          if (conversion == 's')
            {
              if (format == end && format - format_start == 2
-                 && (!new_result || spec->new_string)
                  && ! string_intervals (args[0]))
                return arg;
 

diff --git a/src/lisp.h b/src/lisp.h
index bdb162aea4cecde0e48d2baf7c66ba0397e3bcd0..266370333f5f1e2d05aa94b4f1482fbe8eeba952 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3970,7 +3970,6 @@ extern _Noreturn void time_overflow (void);
 extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
 extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
                                            ptrdiff_t, bool);
-extern Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool, bool);
 extern void init_editfns (bool);
 extern void syms_of_editfns (void);
 

diff --git a/src/xdisp.c b/src/xdisp.c
index 86164eb9f6fa2376ce6d881b4c3448f177bd60f6..141275f15a09e79afd848a1a88a82e0c01a398f4 100644 (file)
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -10194,7 +10194,7 @@ vadd_to_log (char const *format, va_list ap)
   for (ptrdiff_t i = 1; i <= nargs; i++)
     args[i] = va_arg (ap, Lisp_Object);
   Lisp_Object msg = Qnil;
-  msg = styled_format (nargs, args, true, false);
+  msg = Fformat_message (nargs, args);
 
   ptrdiff_t len = SBYTES (msg) + 1;
   USE_SAFE_ALLOCA;
@@ -19525,7 +19525,7 @@ DEFUN ("trace-to-stderr", Ftrace_to_stderr, Strace_to_stderr, 1, MANY, "",
 usage: (trace-to-stderr STRING &rest OBJECTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  Lisp_Object s = styled_format (nargs, args, false, false);
+  Lisp_Object s = Fformat (nargs, args);
   fwrite (SDATA (s), 1, SBYTES (s), stderr);
   return Qnil;
 }