#2 [Was: Re: Function attributes for make-docfile]

[Dmitry Antipov <dmantipov@yandex.ru>]

[-- Attachment #1: Type: text/plain, Size: 728 bytes --]

On 01/12/2015 08:49 AM, Paul Eggert wrote:

> Good idea, but I worry that the comments are fragile.  How about the following
> idea for improving the proposed syntax?  Move the directives to be inside the
> DEFUN, making it clearer that they're part
> of the function definition mechanism.  Something like this, say:
>
>    DEFUN ("eq", Feq, Seq, 2, 2, 0,
>           doc: /* Return t if the two args are the same Lisp object.  */
>           attribute: const)
>
> and similarly for 'noreturn' instead of (or in addition to) 'const'.

Ah yes, this looks better, and not too hard to (re)implement.  The only
minor issue is that 'const' is unconditionally highlighted as a C keyword
but 'noreturn' isn't.

OK to install?

Dmitry


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: function_attributes_2.patch --]
[-- Type: text/x-diff; name="function_attributes_2.patch", Size: 18837 bytes --]

diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index bc5420e..79d421a 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -562,6 +562,7 @@ struct global
 {
   enum global_type type;
   char *name;
+  int flags;
   union
   {
     int value;
@@ -569,13 +570,16 @@ struct global
   } v;
 };
 
+/* Bit values for FLAGS field from the above.  Applied for DEFUNs only.  */
+enum { DEFUN_noreturn = 1, DEFUN_const = 2 };
+
 /* All the variable names we saw while scanning C sources in `-g'
    mode.  */
 int num_globals;
 int num_globals_allocated;
 struct global *globals;
 
-static void
+static struct global *
 add_global (enum global_type type, char *name, int value, char const *svalue)
 {
   /* Ignore the one non-symbol that can occur.  */
@@ -601,7 +605,10 @@ add_global (enum global_type type, char *name, int value, char const *svalue)
 	globals[num_globals - 1].v.svalue = svalue;
       else
 	globals[num_globals - 1].v.value = value;
+      globals[num_globals - 1].flags = 0;
+      return globals + num_globals - 1;
     }
+  return NULL;
 }
 
 static int
@@ -708,13 +715,7 @@ write_globals (void)
 		globals[i].name, globals[i].name, globals[i].name);
       else
 	{
-	  /* It would be nice to have a cleaner way to deal with these
-	     special hacks.  */
-	  if (strcmp (globals[i].name, "Fthrow") == 0
-	      || strcmp (globals[i].name, "Ftop_level") == 0
-	      || strcmp (globals[i].name, "Fkill_emacs") == 0
-	      || strcmp (globals[i].name, "Fexit_recursive_edit") == 0
-	      || strcmp (globals[i].name, "Fabort_recursive_edit") == 0)
+	  if (globals[i].flags & DEFUN_noreturn)
 	    fputs ("_Noreturn ", stdout);
 
 	  printf ("EXFUN (%s, ", globals[i].name);
@@ -726,36 +727,7 @@ write_globals (void)
 	    printf ("%d", globals[i].v.value);
 	  putchar (')');
 
-	  /* It would be nice to have a cleaner way to deal with these
-	     special hacks, too.  */
-	  if (strcmp (globals[i].name, "Fatom") == 0
-	      || strcmp (globals[i].name, "Fbyteorder") == 0
-	      || strcmp (globals[i].name, "Fcharacterp") == 0
-	      || strcmp (globals[i].name, "Fchar_or_string_p") == 0
-	      || strcmp (globals[i].name, "Fconsp") == 0
-	      || strcmp (globals[i].name, "Feq") == 0
-	      || strcmp (globals[i].name, "Fface_attribute_relative_p") == 0
-	      || strcmp (globals[i].name, "Fframe_windows_min_size") == 0
-	      || strcmp (globals[i].name, "Fgnutls_errorp") == 0
-	      || strcmp (globals[i].name, "Fidentity") == 0
-	      || strcmp (globals[i].name, "Fintegerp") == 0
-	      || strcmp (globals[i].name, "Finteractive") == 0
-	      || strcmp (globals[i].name, "Ffloatp") == 0
-	      || strcmp (globals[i].name, "Flistp") == 0
-	      || strcmp (globals[i].name, "Fmax_char") == 0
-	      || strcmp (globals[i].name, "Fnatnump") == 0
-	      || strcmp (globals[i].name, "Fnlistp") == 0
-	      || strcmp (globals[i].name, "Fnull") == 0
-	      || strcmp (globals[i].name, "Fnumberp") == 0
-	      || strcmp (globals[i].name, "Fstringp") == 0
-	      || strcmp (globals[i].name, "Fsymbolp") == 0
-	      || strcmp (globals[i].name, "Ftool_bar_height") == 0
-	      || strcmp (globals[i].name, "Fwindow__sanitize_window_sizes") == 0
-#ifndef WINDOWSNT
-	      || strcmp (globals[i].name, "Fgnutls_available_p") == 0
-	      || strcmp (globals[i].name, "Fzlib_available_p") == 0
-#endif
-	      || 0)
+	  if (globals[i].flags & DEFUN_const)
 	    fputs (" ATTRIBUTE_CONST", stdout);
 
 	  puts (";");
@@ -817,6 +789,23 @@ scan_c_file (char *filename, const char *mode)
   return scan_c_stream (infile);
 }
 
+/* Return 1 if next input from INFILE is equal to P, -1 if EOF,
+   0 if input doesn't match.  */
+
+static int
+stream_match (FILE *infile, const char *p)
+{
+  for (; *p; p++)
+    {
+      int c = getc (infile);
+      if (c == EOF)
+       return -1;
+      if (c != *p)
+       return 0;
+    }
+  return 1;
+}
+
 static int
 scan_c_stream (FILE *infile)
 {
@@ -1033,7 +1022,63 @@ scan_c_stream (FILE *infile)
 
       if (generate_globals)
 	{
-	  add_global (FUNCTION, name, maxargs, 0);
+	  struct global *g = add_global (FUNCTION, name, maxargs, 0);
+
+	  /* The following code tries to recognize function attributes
+	     specified after the docstring, e.g.:
+
+	     DEFUN ("foo", Ffoo, Sfoo, X, Y, Z,
+		   doc: /\* doc *\/
+		   attributes: attribute1 attribute2 ...)
+	       (Lisp_Object arg...)
+
+	     Now only 'noreturn' and 'const' attributes are used.  */
+
+	  /* Advance to the end of docstring.  */
+	  c = getc (infile);
+	  if (c == EOF)
+	    goto eof;
+	  int d = getc (infile);
+	  if (d == EOF)
+	    goto eof;
+	  while (1)
+	    {
+	      if (c == '*' && d == '/')
+		break;
+	      c = d, d = getc (infile);
+	      if (d == EOF)
+		goto eof;
+	    }
+	  /* Skip spaces, if any.  */
+	  do
+	    {
+	      c = getc (infile);
+	      if (c == EOF)
+		goto eof;
+	    }
+	  while (c == ' ' || c == '\n' || c == '\r' || c == '\t');
+	  /* Check for 'attributes:' token.  */
+	  if (c == 'a' && stream_match (infile, "ttributes:"))
+	    {
+	      char *p = input_buffer;
+	      /* Collect attributes up to ')'.  */
+	      while (1)
+		{
+		  c = getc (infile);
+		  if (c == EOF)
+		    goto eof;
+		  if (c == ')')
+		    break;
+		  if (p - input_buffer > sizeof (input_buffer))
+		    abort ();
+		  *p++ = c;
+		}
+	      *p = 0;
+	      if (strstr (input_buffer, "noreturn"))
+		g->flags |= DEFUN_noreturn;
+	      if (strstr (input_buffer, "const"))
+		g->flags |= DEFUN_const;
+	    }
 	  continue;
 	}
 
diff --git a/src/callint.c b/src/callint.c
index 2595503..dd238b9 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -101,7 +101,8 @@ If the string begins with `^' and `shift-select-mode' is non-nil,
  Emacs first calls the function `handle-shift-selection'.
 You may use `@', `*', and `^' together.  They are processed in the
  order that they appear, before reading any arguments.
-usage: (interactive &optional ARGS)  */)
+usage: (interactive &optional ARGS)  */
+       attributes: const)
   (Lisp_Object args)
 {
   return Qnil;
diff --git a/src/character.c b/src/character.c
index 4a5c7ec..39d32c9 100644
--- a/src/character.c
+++ b/src/character.c
@@ -232,14 +232,16 @@ DEFUN ("characterp", Fcharacterp, Scharacterp, 1, 2, 0,
 In Emacs Lisp, characters are represented by character codes, which
 are non-negative integers.  The function `max-char' returns the
 maximum character code.
-usage: (characterp OBJECT)  */)
+usage: (characterp OBJECT)  */
+       attributes: const)
   (Lisp_Object object, Lisp_Object ignore)
 {
   return (CHARACTERP (object) ? Qt : Qnil);
 }
 
 DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0,
-       doc: /* Return the character of the maximum code.  */)
+       doc: /* Return the character of the maximum code.  */
+       attributes: const)
   (void)
 {
   return make_number (MAX_CHAR);
diff --git a/src/data.c b/src/data.c
index 820c3ce..0389eb4 100644
--- a/src/data.c
+++ b/src/data.c
@@ -176,7 +176,8 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
 /* Data type predicates.  */
 
 DEFUN ("eq", Feq, Seq, 2, 2, 0,
-       doc: /* Return t if the two args are the same Lisp object.  */)
+       doc: /* Return t if the two args are the same Lisp object.  */
+       attributes: const)
   (Lisp_Object obj1, Lisp_Object obj2)
 {
   if (EQ (obj1, obj2))
@@ -185,7 +186,8 @@ DEFUN ("eq", Feq, Seq, 2, 2, 0,
 }
 
 DEFUN ("null", Fnull, Snull, 1, 1, 0,
-       doc: /* Return t if OBJECT is nil.  */)
+       doc: /* Return t if OBJECT is nil.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (NILP (object))
@@ -263,7 +265,8 @@ for example, (type-of 1) returns `integer'.  */)
 }
 
 DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a cons cell.  */)
+       doc: /* Return t if OBJECT is a cons cell.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (CONSP (object))
@@ -272,7 +275,8 @@ DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0,
 }
 
 DEFUN ("atom", Fatom, Satom, 1, 1, 0,
-       doc: /* Return t if OBJECT is not a cons cell.  This includes nil.  */)
+       doc: /* Return t if OBJECT is not a cons cell.  This includes nil.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (CONSP (object))
@@ -282,7 +286,8 @@ DEFUN ("atom", Fatom, Satom, 1, 1, 0,
 
 DEFUN ("listp", Flistp, Slistp, 1, 1, 0,
        doc: /* Return t if OBJECT is a list, that is, a cons cell or nil.
-Otherwise, return nil.  */)
+Otherwise, return nil.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (CONSP (object) || NILP (object))
@@ -291,7 +296,8 @@ Otherwise, return nil.  */)
 }
 
 DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
-       doc: /* Return t if OBJECT is not a list.  Lists include nil.  */)
+       doc: /* Return t if OBJECT is not a list.  Lists include nil.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (CONSP (object) || NILP (object))
@@ -300,7 +306,8 @@ DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0,
 }
 \f
 DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a symbol.  */)
+       doc: /* Return t if OBJECT is a symbol.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (SYMBOLP (object))
@@ -333,7 +340,8 @@ DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0,
 }
 
 DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a string.  */)
+       doc: /* Return t if OBJECT is a string.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (STRINGP (object))
@@ -436,7 +444,8 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
 }
 
 DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
-       doc: /* Return t if OBJECT is a character or a string.  */)
+       doc: /* Return t if OBJECT is a character or a string.  */
+       attributes: const)
   (register Lisp_Object object)
 {
   if (CHARACTERP (object) || STRINGP (object))
@@ -445,7 +454,8 @@ DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
 }
 \f
 DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
-       doc: /* Return t if OBJECT is an integer.  */)
+       doc: /* Return t if OBJECT is an integer.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (INTEGERP (object))
@@ -463,7 +473,8 @@ DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1,
 }
 
 DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
-       doc: /* Return t if OBJECT is a nonnegative integer.  */)
+       doc: /* Return t if OBJECT is a nonnegative integer.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (NATNUMP (object))
@@ -472,7 +483,8 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
 }
 
 DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a number (floating point or integer).  */)
+       doc: /* Return t if OBJECT is a number (floating point or integer).  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (NUMBERP (object))
@@ -492,7 +504,8 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p,
 }
 
 DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
-       doc: /* Return t if OBJECT is a floating point number.  */)
+       doc: /* Return t if OBJECT is a floating point number.  */
+       attributes: const)
   (Lisp_Object object)
 {
   if (FLOATP (object))
@@ -2954,7 +2967,8 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
 DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0,
        doc: /* Return the byteorder for the machine.
 Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII
-lowercase l) for small endian machines.  */)
+lowercase l) for small endian machines.  */
+       attributes: const)
   (void)
 {
   unsigned i = 0x04030201;
diff --git a/src/decompress.c b/src/decompress.c
index b14f0a2..b78dace 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -88,7 +88,8 @@ unwind_decompress (void *ddata)
 }
 
 DEFUN ("zlib-available-p", Fzlib_available_p, Szlib_available_p, 0, 0, 0,
-       doc: /* Return t if zlib decompression is available in this instance of Emacs.  */)
+       doc: /* Return t if zlib decompression is available in this instance of Emacs.  */
+       attributes: const)
      (void)
 {
 #ifdef WINDOWSNT
diff --git a/src/emacs.c b/src/emacs.c
index d09c3c3..ca1a8b2 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1892,7 +1892,8 @@ or SIGHUP, and upon SIGINT in batch mode.
 
 The value of `kill-emacs-hook', if not void,
 is a list of functions (of no args),
-all of which are called before Emacs is actually killed.  */)
+all of which are called before Emacs is actually killed.  */
+       attributes: noreturn)
   (Lisp_Object arg)
 {
   struct gcpro gcpro1;
diff --git a/src/eval.c b/src/eval.c
index 7e4b016..5cadb1b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1162,7 +1162,8 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
 
 DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
        doc: /* Throw to the catch for TAG and return VALUE from it.
-Both TAG and VALUE are evalled.  */)
+Both TAG and VALUE are evalled.  */
+       attributes: noreturn)
   (register Lisp_Object tag, Lisp_Object value)
 {
   struct handler *c;
diff --git a/src/fns.c b/src/fns.c
index 7739663..91cd513 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -46,7 +46,8 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t,
 static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object);
 
 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
-       doc: /* Return the argument unchanged.  */)
+       doc: /* Return the argument unchanged.  */
+       attributes: const)
   (Lisp_Object arg)
 {
   return arg;
diff --git a/src/frame.c b/src/frame.c
index 3d2ffbf..150c058 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -267,7 +267,8 @@ predicates which report frame's specific UI-related capabilities.  */)
 /* Placeholder used by temacs -nw before window.el is loaded.  */
 DEFUN ("frame-windows-min-size", Fframe_windows_min_size,
        Sframe_windows_min_size, 4, 4, 0,
-       doc: /* */)
+       doc: /* */
+       attributes: const)
      (Lisp_Object frame, Lisp_Object horizontal,
       Lisp_Object ignore, Lisp_Object pixelwise)
 {
diff --git a/src/gnutls.c b/src/gnutls.c
index 75fe614..5e6c635 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -695,7 +695,8 @@ See also `gnutls-boot'.  */)
 DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
        doc: /* Return t if ERROR indicates a GnuTLS problem.
 ERROR is an integer or a symbol with an integer `gnutls-code' property.
-usage: (gnutls-errorp ERROR)  */)
+usage: (gnutls-errorp ERROR)  */
+       attributes: const)
   (Lisp_Object err)
 {
   if (EQ (err, Qt)) return Qnil;
@@ -1603,7 +1604,8 @@ This function may also return `gnutls-e-again', or
 #endif	/* HAVE_GNUTLS */
 
 DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
-       doc: /* Return t if GnuTLS is available in this instance of Emacs.  */)
+       doc: /* Return t if GnuTLS is available in this instance of Emacs.  */
+       attributes: const)
      (void)
 {
 #ifdef HAVE_GNUTLS
diff --git a/src/keyboard.c b/src/keyboard.c
index 5411aff..c1207f8 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1163,7 +1163,8 @@ top_level_1 (Lisp_Object ignore)
 
 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
        doc: /* Exit all recursive editing levels.
-This also exits all active minibuffers.  */)
+This also exits all active minibuffers.  */
+       attributes: noreturn)
   (void)
 {
 #ifdef HAVE_WINDOW_SYSTEM
@@ -1186,7 +1187,8 @@ user_error (const char *msg)
 
 /* _Noreturn will be added to prototype by make-docfile.  */
 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
-       doc: /* Exit from the innermost recursive edit or minibuffer.  */)
+       doc: /* Exit from the innermost recursive edit or minibuffer.  */
+       attributes: noreturn)
   (void)
 {
   if (command_loop_level > 0 || minibuf_level > 0)
@@ -1197,7 +1199,8 @@ DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0,
 
 /* _Noreturn will be added to prototype by make-docfile.  */
 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
-       doc: /* Abort the command that requested this recursive edit or minibuffer input.  */)
+       doc: /* Abort the command that requested this recursive edit or minibuffer input.  */
+       attributes: noreturn)
   (void)
 {
   if (command_loop_level > 0 || minibuf_level > 0)
diff --git a/src/window.c b/src/window.c
index 1d2221f..e11299e 100644
--- a/src/window.c
+++ b/src/window.c
@@ -3000,7 +3000,8 @@ resize_root_window (Lisp_Object window, Lisp_Object delta, Lisp_Object horizonta
 /* Placeholder used by temacs -nw before window.el is loaded.  */
 DEFUN ("window--sanitize-window-sizes", Fwindow__sanitize_window_sizes,
        Swindow__sanitize_window_sizes, 2, 2, 0,
-       doc: /* */)
+       doc: /* */
+       attributes: const)
      (Lisp_Object frame, Lisp_Object horizontal)
 {
   return Qnil;
diff --git a/src/xdisp.c b/src/xdisp.c
index 31702ed..bb7ad19 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -12276,7 +12276,8 @@ DEFUN ("tool-bar-height", Ftool_bar_height, Stool_bar_height,
        0, 2, 0,
        doc: /* Return the number of lines occupied by the tool bar of FRAME.
 If FRAME is nil or omitted, use the selected frame.  Optional argument
-PIXELWISE non-nil means return the height of the tool bar in pixels.  */)
+PIXELWISE non-nil means return the height of the tool bar in pixels.  */
+       attributes: const)
   (Lisp_Object frame, Lisp_Object pixelwise)
 {
   int height = 0;
diff --git a/src/xfaces.c b/src/xfaces.c
index 6ecd857..85af770 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -3546,7 +3546,8 @@ with the value VALUE is relative.
 A relative value is one that doesn't entirely override whatever is
 inherited from another face.  For most possible attributes,
 the only relative value that users see is `unspecified'.
-However, for :height, floating point values are also relative.  */)
+However, for :height, floating point values are also relative.  */
+       attributes: const)
   (Lisp_Object attribute, Lisp_Object value)
 {
   if (EQ (value, Qunspecified) || (EQ (value, QCignore_defface)))