]> git.eshelyaron.com Git - emacs.git/commitdiff
* lisp/emacs-lisp/byte-run.el (defmacro, defun): Move from C.
authorStefan Monnier <monnier@iro.umontreal.ca>
Wed, 30 May 2012 03:59:42 +0000 (23:59 -0400)
committerStefan Monnier <monnier@iro.umontreal.ca>
Wed, 30 May 2012 03:59:42 +0000 (23:59 -0400)
(macro-declaration-function): Move var from C code.
(macro-declaration-function): Define function with defalias.
* lisp/emacs-lisp/macroexp.el (macroexpand-all-1):
* lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form):
* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't handle
defun/defmacro any more.
* lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-signature):
Provide fallback for unknown arglist.
(byte-compile-arglist-warn): Change calling convention.
(byte-compile-output-file-form): Move print-vars binding.
(byte-compile-output-docform): Simplify accordingly.
(byte-compile-file-form-defun, byte-compile-file-form-defmacro)
(byte-compile-defmacro-declaration): Remove.
(byte-compile-file-form-defmumble): Generalize to defalias.
(byte-compile-output-as-comment): Return byte-positions.
Simplify callers accordingly.
(byte-compile-lambda): Use `assert'.
(byte-compile-defun, byte-compile-defmacro): Remove.
(byte-compile-file-form-defalias):
Use byte-compile-file-form-defmumble.
(byte-compile-defalias-warn): Remove.
* src/eval.c (Fdefun, Fdefmacro, Vmacro_declaration_function):
Move to byte-run.el.
(Fautoload): Do the hash-doc more carefully.
* src/data.c (Fdefalias): Purify definition, except for keymaps.
(Qdefun): Move from eval.c.
* src/lisp.h (Qdefun): Remove.
* src/lread.c (read1): Tiny simplification.
* lib-src/make-docfile.c: Improve comment style.
(search_lisp_doc_at_eol): New function.
(scan_lisp_file): Use it.

16 files changed:
lib-src/ChangeLog
lib-src/make-docfile.c
lisp/ChangeLog
lisp/emacs-lisp/byte-opt.el
lisp/emacs-lisp/byte-run.el
lisp/emacs-lisp/bytecomp.el
lisp/emacs-lisp/cconv.el
lisp/emacs-lisp/elint.el
lisp/emacs-lisp/lisp-mode.el
lisp/emacs-lisp/macroexp.el
lisp/loadup.el
src/ChangeLog
src/data.c
src/eval.c
src/lisp.h
src/lread.c

index 7dc02ccaa954a57458173880dd88575e31660642..d95137852e0d9a33bf54396bea336a32d49b912d 100644 (file)
@@ -1,3 +1,9 @@
+2012-05-30  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * make-docfile.c: Improve comment style.
+       (search_lisp_doc_at_eol): New function.
+       (scan_lisp_file): Use it.
+
 2012-05-26  Glenn Morris  <rgm@gnu.org>
 
        * Makefile.in (INSTALL_DATA): Remove; unused.
 
        * etags.c (canonicalize_filename, ISUPPER): Fix last change.
 
-       * makefile.w32-in ($(BLD)/ebrowse.$(O), $(BLD)/pop.$(O)): Depend
-       on ../lib/min-max.h.
+       * makefile.w32-in ($(BLD)/ebrowse.$(O), $(BLD)/pop.$(O)):
+       Depend on ../lib/min-max.h.
 
 2011-02-22  Paul Eggert  <eggert@cs.ucla.edu>
 
 
        * make-docfile.c (read_c_string_or_comment): Declare msgno.
 
-       * Makefile.in (YACC): Deleted.
+       * Makefile.in (YACC): Delete.
 
 2002-10-19  Andreas Schwab  <schwab@suse.de>
 
        (TeX_commands): Names now include the initial backslash.
        (TeX_commands): Names do not include numeric args #n.
        (TeX_commands): Correct line char number in tags.
-       (TEX_tabent, TEX_token): Deleted.
+       (TEX_tabent, TEX_token): Delete.
        (TeX_commands, TEX_decode_env): Streamlined.
 
 2002-06-05  Francesco Potortì  <pot@gnu.org>
        (main): New argument -d, for specifying directory.
        (usage): Document.
        (get_user_id): Compute.
-       (get_home_dir): Deleted.
+       (get_home_dir): Delete.
        (get_prefix): New function, taken from main.
        (main): Check whether or not we are running setuid.  Move prefix
        computation to get_prefix.  Don't call getpwent; we don't need to
        (LOOKING_AT, get_tag, PHP_functions): Use notinname.
        (Ada_getit, Ada_funcs, Python_functions, Scheme_functions):
        Clarified, using strneq or notinname.
-       (L_isdef, L_isquote): Removed.
+       (L_isdef, L_isquote): Remove.
        (Lisp_functions, L_getit): Clarified.
 
        * etags.c (P_): Rename to __P for consistency with config.h.
        comma when --declarations is used.
        (C_entries): More accurate tagging of members and declarations.
        (yacc_rules): Was global, made local to C_entries.
-       (next_token_is_func): Removed.
+       (next_token_is_func): Remove.
        (fvdef): New constants fdefunkey, fdefunname.
        (consider_token, C_entries): Use them.
        (C_entries): Build proper lisp names for Emacs DEFUNs.
        (find_entries, takeprec, getit, Fortran_functions, Perl_functions)
        (Python_functions, L_getit, Lisp_functions, Scheme_functions)
        (prolog_pred, erlanf_func, erlang_attribute): Use them.
-       (eat_white): Deleted.
+       (eat_white): Delete.
 
        * etags.c (CHAR, init): Keep into account non US-ASCII
        characters and compilers with default signed chars.
 1997-05-13  Francesco Potortì  <F.Potorti@cnuce.cnr.it>
 
        * etags.c (TeX_functions): Cleaned up.
-       (tex_getit): Removed.
+       (tex_getit): Remove.
 
 1997-05-13  Paul Eggert  <eggert@twinsun.com>
 
 
        * etags.c: Prolog language totally rewritten.
        (Prolog_functions): Rewritten from scratch.
-       (skip_comment, prolog_getit): Removed.
+       (skip_comment, prolog_getit): Remove.
        (prolog_skip_comment): New function, like old skip_comment.
        (prolog_pred, prolog_atom, prolog_white): New functions.
        (erlang_func, erlang_attributes): Forward declarations added.
 
 1995-01-12  Francesco Potortì  (pot@cnuce.cnr.it)
 
-       * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Deleted.
+       * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Delete.
        (append_to_tagfile, typedefs, typedefs_and_cplusplus)
        (constantypedefs, update, vgrind_style, no_warnings)
        (cxref_style, cplusplus, noindentypedefs): Were int, now logical.
        (consider_token): Don't take a token as argument.  Use savenstr
        when saving a tag in structtag.  Callers changed.
        (TOKEN): Structure changed.  Now used only in C_entries.
-       (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Deleted.
+       (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Delete.
        (C_entries): nameb and savenameb deleted.  Use dinamic allocation.
-       (pfcnt): Deleted.  Users updated.
+       (pfcnt): Delete.  Users updated.
        (getit, Asm_labels, Pascal_functions, L_getit, get_scheme)
        (TEX_getit, prolog_getit): Use dinamic allocation for storing
        the tag instead of a fixed size buffer.
 
 1994-03-25  Francesco Potortì  (pot@cnuce.cnr.it)
 
-       * etags.c (emacs_tags_format, ETAGS): Removed.  Use CTAGS instead.
+       * etags.c (emacs_tags_format, ETAGS): Remove.  Use CTAGS instead.
        (main): Don't allow the use of -t and -T in etags mode.
        (print_help): Don't show options enabled by default.
        (print_version): Show the emacs version number if VERSION is #defined.
 1994-01-14  Francesco Potortì  (pot@cnuce.cnr.it)
 
        * etags.c (stab_entry, stab_create, stab_find, stab_search,
-       stab_type, add_keyword, C_reate_stab, C_create_stabs): Deleted.
+       stab_type, add_keyword, C_reate_stab, C_create_stabs): Delete.
        Use gperf generated hash table instead of linked list.
-       (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Added.
+       (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Add.
        Mostly code generated by gperf.
        (consider_token): Remove unused parameter `lp'.
        (PF_funcs, getit): Allow subroutine and similar declarations
        * etags.c (consider_token): Was `==', now is `='.
        (consider_token): DEFUNs now treated like funcs in ctags mode.
 
-       * etags.c (LEVEL_OK_FOR_FUNCDEF): Removed.
+       * etags.c (LEVEL_OK_FOR_FUNCDEF): Remove.
        (C_entries): Optimized the test that used LEVEL_OK_FOR_FUNCDEF.
        (C_entries): Remove a piece of useless code.
        (C_entries): Making typedef tags is delayed until a semicolon
        * etags.c (GET_COOKIE): And related macros removed.
        (logical): Is now int, no more a char.
        (reg): Define deleted.
-       (isgood, _gd, notgd): Deleted.
-       (gotone): Deleted.
+       (isgood, _gd, notgd): Delete.
+       (gotone): Delete.
        (TOKEN): Member linestart removed.
-       (linepos, prev_linepos, lb1): Deleted.
+       (linepos, prev_linepos, lb1): Delete.
        (main): Call initbuffer on lbs array instead of lb1.
        (init): Remove the initialization of the logical _gd array.
        (find_entries): A .sa suffix means assembler file.
        All C state machines rewritten.
        (C_entries): Complete rewrite.
        (condider_token): Complete rewrite.
-       (getline): Deleted.
+       (getline): Delete.
 
 1993-03-01  Francesco Potortì  (pot@fly.CNUCE.CNR.IT)
 
index b33b13f34ce982f35148359a19a8a7f481687b73..1314a7b68291ae260259b7599cdace549cd3b770 100644 (file)
@@ -35,7 +35,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include <config.h>
 
-/* defined to be emacs_main, sys_fopen, etc. in config.h */
+/* Defined to be emacs_main, sys_fopen, etc. in config.h.  */
 #undef main
 #undef fopen
 #undef chdir
@@ -66,7 +66,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)
 #endif
 
-/* Use this to suppress gcc's `...may be used before initialized' warnings. */
+/* Use this to suppress gcc's `...may be used before initialized' warnings.  */
 #ifdef lint
 # define IF_LINT(Code) Code
 #else
@@ -226,7 +226,7 @@ put_filename (char *filename)
 
   for (tmp = filename; *tmp; tmp++)
     {
-      if (IS_DIRECTORY_SEP(*tmp))
+      if (IS_DIRECTORY_SEP (*tmp))
        filename = tmp + 1;
     }
 
@@ -675,14 +675,14 @@ scan_c_file (char *filename, const char *mode)
 
   if (infile == NULL && extension == 'o')
     {
-      /* try .m */
+      /* Try .m.  */
       filename[strlen (filename) - 1] = 'm';
       infile = fopen (filename, mode);
       if (infile == NULL)
-        filename[strlen (filename) - 1] = 'c'; /* don't confuse people */
+        filename[strlen (filename) - 1] = 'c'; /* Don't confuse people.  */
     }
 
-  /* No error if non-ex input file */
+  /* No error if non-ex input file */
   if (infile == NULL)
     {
       perror (filename);
@@ -800,8 +800,8 @@ scan_c_file (char *filename, const char *mode)
              input_buffer[i++] = c;
              c = getc (infile);
            }
-         while (! (c == ',' || c == ' ' || c == '\t' ||
-                   c == '\n' || c == '\r'));
+         while (! (c == ',' || c == ' ' || c == '\t'
+                   || c == '\n' || c == '\r'));
          input_buffer[i] = '\0';
 
          name = xmalloc (i + 1);
@@ -820,7 +820,7 @@ scan_c_file (char *filename, const char *mode)
        commas = 3;
       else if (defvarflag)
        commas = 1;
-      else  /* For DEFSIMPLE and DEFPRED */
+      else  /* For DEFSIMPLE and DEFPRED */
        commas = 2;
 
       while (commas)
@@ -838,9 +838,9 @@ scan_c_file (char *filename, const char *mode)
                  if (c < 0)
                    goto eof;
                  ungetc (c, infile);
-                 if (commas == 2) /* pick up minargs */
+                 if (commas == 2) /* Pick up minargs.  */
                    scanned = fscanf (infile, "%d", &minargs);
-                 else /* pick up maxargs */
+                 else /* Pick up maxargs.  */
                    if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
                      maxargs = -1;
                    else
@@ -893,7 +893,7 @@ scan_c_file (char *filename, const char *mode)
          fprintf (outfile, "%s\n", input_buffer);
 
          if (comment)
-           getc (infile);      /* Skip past `*' */
+           getc (infile);      /* Skip past `*' */
          c = read_c_string_or_comment (infile, 1, comment, &saw_usage);
 
          /* If this is a defun, find the arguments and print them.  If
@@ -979,7 +979,7 @@ scan_c_file (char *filename, const char *mode)
  problem because byte-compiler output follows this convention.
  The NAME and DOCSTRING are output.
  NAME is preceded by `F' for a function or `V' for a variable.
- An entry is output only if DOCSTRING has \ newline just after the opening "
+ An entry is output only if DOCSTRING has \ newline just after the opening ".
  */
 
 static void
@@ -1019,6 +1019,32 @@ read_lisp_symbol (FILE *infile, char *buffer)
   skip_white (infile);
 }
 
+static int
+search_lisp_doc_at_eol (FILE *infile)
+{
+  char c = 0, c1 = 0, c2 = 0;
+
+  /* Skip until the end of line; remember two previous chars.  */
+  while (c != '\n' && c != '\r' && c >= 0)
+    {
+      c2 = c1;
+      c1 = c;
+      c = getc (infile);
+    }
+
+  /* If two previous characters were " and \,
+     this is a doc string.  Otherwise, there is none.  */
+  if (c2 != '"' || c1 != '\\')
+    {
+#ifdef DEBUG
+      fprintf (stderr, "## non-docstring in %s (%s)\n",
+              buffer, filename);
+#endif
+      return 0;
+    }
+  return 1;
+}
+
 static int
 scan_lisp_file (const char *filename, const char *mode)
 {
@@ -1033,7 +1059,7 @@ scan_lisp_file (const char *filename, const char *mode)
   if (infile == NULL)
     {
       perror (filename);
-      return 0;                                /* No error */
+      return 0;                                /* No error */
     }
 
   c = '\n';
@@ -1110,7 +1136,7 @@ scan_lisp_file (const char *filename, const char *mode)
          type = 'F';
          read_lisp_symbol (infile, buffer);
 
-         /* Skip the arguments: either "nil" or a list in parens */
+         /* Skip the arguments: either "nil" or a list in parens */
 
          c = getc (infile);
          if (c == 'n') /* nil */
@@ -1154,39 +1180,18 @@ scan_lisp_file (const char *filename, const char *mode)
               || ! strcmp (buffer, "defconst")
               || ! strcmp (buffer, "defcustom"))
        {
-         char c1 = 0, c2 = 0;
          type = 'V';
          read_lisp_symbol (infile, buffer);
 
          if (saved_string == 0)
-           {
-
-             /* Skip until the end of line; remember two previous chars.  */
-             while (c != '\n' && c != '\r' && c >= 0)
-               {
-                 c2 = c1;
-                 c1 = c;
-                 c = getc (infile);
-               }
-
-             /* If two previous characters were " and \,
-                this is a doc string.  Otherwise, there is none.  */
-             if (c2 != '"' || c1 != '\\')
-               {
-#ifdef DEBUG
-                 fprintf (stderr, "## non-docstring in %s (%s)\n",
-                          buffer, filename);
-#endif
-                 continue;
-               }
-           }
+           if (!search_lisp_doc_at_eol (infile))
+             continue;
        }
 
       else if (! strcmp (buffer, "custom-declare-variable")
               || ! strcmp (buffer, "defvaralias")
               )
        {
-         char c1 = 0, c2 = 0;
          type = 'V';
 
          c = getc (infile);
@@ -1221,31 +1226,12 @@ scan_lisp_file (const char *filename, const char *mode)
            }
 
          if (saved_string == 0)
-           {
-             /* Skip to end of line; remember the two previous chars.  */
-             while (c != '\n' && c != '\r' && c >= 0)
-               {
-                 c2 = c1;
-                 c1 = c;
-                 c = getc (infile);
-               }
-
-             /* If two previous characters were " and \,
-                this is a doc string.  Otherwise, there is none.  */
-             if (c2 != '"' || c1 != '\\')
-               {
-#ifdef DEBUG
-                 fprintf (stderr, "## non-docstring in %s (%s)\n",
-                          buffer, filename);
-#endif
-                 continue;
-               }
-           }
+           if (!search_lisp_doc_at_eol (infile))
+             continue;
        }
 
       else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
        {
-         char c1 = 0, c2 = 0;
          type = 'F';
 
          c = getc (infile);
@@ -1278,26 +1264,8 @@ scan_lisp_file (const char *filename, const char *mode)
            }
 
          if (saved_string == 0)
-           {
-             /* Skip to end of line; remember the two previous chars.  */
-             while (c != '\n' && c != '\r' && c >= 0)
-               {
-                 c2 = c1;
-                 c1 = c;
-                 c = getc (infile);
-               }
-
-             /* If two previous characters were " and \,
-                this is a doc string.  Otherwise, there is none.  */
-             if (c2 != '"' || c1 != '\\')
-               {
-#ifdef DEBUG
-                 fprintf (stderr, "## non-docstring in %s (%s)\n",
-                          buffer, filename);
-#endif
-                 continue;
-               }
-           }
+           if (!search_lisp_doc_at_eol (infile))
+             continue;
        }
 
       else if (! strcmp (buffer, "autoload"))
@@ -1339,23 +1307,10 @@ scan_lisp_file (const char *filename, const char *mode)
              continue;
            }
          read_c_string_or_comment (infile, 0, 0, 0);
-         skip_white (infile);
 
          if (saved_string == 0)
-           {
-             /* If the next three characters aren't `dquote bslash newline'
-                then we're not reading a docstring.  */
-             if ((c = getc (infile)) != '"'
-                 || (c = getc (infile)) != '\\'
-                 || ((c = getc (infile)) != '\n' && c != '\r'))
-               {
-#ifdef DEBUG
-                 fprintf (stderr, "## non-docstring in %s (%s)\n",
-                          buffer, filename);
-#endif
-                 continue;
-               }
-           }
+           if (!search_lisp_doc_at_eol (infile))
+             continue;
        }
 
 #ifdef DEBUG
@@ -1373,12 +1328,10 @@ scan_lisp_file (const char *filename, const char *mode)
          continue;
        }
 
-      /* At this point, we should either use the previous
-        dynamic doc string in saved_string
-        or gobble a doc string from the input file.
-
-        In the latter case, the opening quote (and leading
-        backslash-newline) have already been read.  */
+      /* At this point, we should either use the previous dynamic doc string in
+        saved_string or gobble a doc string from the input file.
+        In the latter case, the opening quote (and leading backslash-newline)
+        have already been read.  */
 
       putc (037, outfile);
       putc (type, outfile);
index 80cbdef406c6b83cb4a7c65c0da81b266c77ff4b..ccd4de5f7542dd6be5af1f3864eb30bb1f2dc096 100644 (file)
@@ -1,8 +1,32 @@
+2012-05-30  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * emacs-lisp/byte-run.el (defmacro, defun): Move from C.
+       (macro-declaration-function): Move var from C code.
+       (macro-declaration-function): Define function with defalias.
+       * emacs-lisp/macroexp.el (macroexpand-all-1):
+       * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form):
+       * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't handle
+       defun/defmacro any more.
+       * emacs-lisp/bytecomp.el (byte-compile-arglist-signature):
+       Provide fallback for unknown arglist.
+       (byte-compile-arglist-warn): Change calling convention.
+       (byte-compile-output-file-form): Move print-vars binding.
+       (byte-compile-output-docform): Simplify accordingly.
+       (byte-compile-file-form-defun, byte-compile-file-form-defmacro)
+       (byte-compile-defmacro-declaration): Remove.
+       (byte-compile-file-form-defmumble): Generalize to defalias.
+       (byte-compile-output-as-comment): Return byte-positions.
+       Simplify callers accordingly.
+       (byte-compile-lambda): Use `assert'.
+       (byte-compile-defun, byte-compile-defmacro): Remove.
+       (byte-compile-file-form-defalias):
+       Use byte-compile-file-form-defmumble.
+       (byte-compile-defalias-warn): Remove.
+
 2012-05-29  Stefan Merten  <smerten@oekonux.de>
 
        * textmodes/rst.el: Silence `checkdoc-ispell' errors where
-       possible.  Fix authors.  Improve comments.  Improve loading of
-       `cl'.
+       possible.  Fix authors.  Improve comments.  Improve loading of `cl'.
 
        (rst-mode-abbrev-table): Merge definition.
        (rst-mode): Make sure `font-lock-defaults' is buffer local.
@@ -14,8 +38,8 @@
        (icalendar-export-region): Export UID properly.
 
 2012-05-29 Leo <sdl.web@gmail.com>
-       * calendar/icalendar.el (icalendar-import-format): Add
-       `icalendar-import-format-uid' (Bug#11525).
+       * calendar/icalendar.el (icalendar-import-format):
+       Add `icalendar-import-format-uid' (Bug#11525).
        (icalendar-import-format-uid): New.
        (icalendar--parse-summary-and-rest, icalendar--format-ical-event):
        Export UID.
index 9dd475f2a5108adefaee3b9cb0c3f308f6959427..7cb93890cb55cd96d82afed14166f66cd11bb000 100644 (file)
                              (prin1-to-string form))
           nil)
 
-         ((memq fn '(defun defmacro function condition-case))
+         ((memq fn '(function condition-case))
           ;; These forms are compiled as constants or by breaking out
           ;; all the subexpressions and compiling them separately.
           form)
index 7de3396f8edea5288a0af0eb169d45e9f949d7da..9b04e9889dd938370cb7e34c0906394e7c31a47a 100644 (file)
 ;; handle declarations in macro definitions and this is the first file
 ;; loaded by loadup.el that uses declarations in macros.
 
-(defun macro-declaration-function (macro decl)
-  "Process a declaration found in a macro definition.
+(defvar macro-declaration-function #'macro-declaration-function
+  "Function to process declarations in a macro definition.
+The function will be called with two args MACRO and DECL.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The value the function returns is not used.")
+
+(defalias 'macro-declaration-function
+  #'(lambda (macro decl)
+      "Process a declaration found in a macro definition.
 This is set as the value of the variable `macro-declaration-function'.
 MACRO is the name of the macro being defined.
 DECL is a list `(declare ...)' containing the declarations.
 The return value of this function is not used."
-  ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
-  (let (d)
-    ;; Ignore the first element of `decl' (it's always `declare').
-    (while (setq decl (cdr decl))
-      (setq d (car decl))
-      (if (and (consp d)
-              (listp (cdr d))
-              (null (cdr (cdr d))))
-         (cond ((eq (car d) 'indent)
-                (put macro 'lisp-indent-function (car (cdr d))))
-               ((eq (car d) 'debug)
-                (put macro 'edebug-form-spec (car (cdr d))))
-               ((eq (car d) 'doc-string)
-                (put macro 'doc-string-elt (car (cdr d))))
-               (t
-                (message "Unknown declaration %s" d)))
-       (message "Invalid declaration %s" d)))))
-
-
-(setq macro-declaration-function 'macro-declaration-function)
-
+      ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
+      (let (d)
+        ;; Ignore the first element of `decl' (it's always `declare').
+        (while (setq decl (cdr decl))
+          (setq d (car decl))
+          (if (and (consp d)
+                   (listp (cdr d))
+                   (null (cdr (cdr d))))
+              (cond ((eq (car d) 'indent)
+                     (put macro 'lisp-indent-function (car (cdr d))))
+                    ((eq (car d) 'debug)
+                     (put macro 'edebug-form-spec (car (cdr d))))
+                    ((eq (car d) 'doc-string)
+                     (put macro 'doc-string-elt (car (cdr d))))
+                    (t
+                     (message "Unknown declaration %s" d)))
+            (message "Invalid declaration %s" d))))))
+
+(put 'defmacro 'doc-string-elt 3)
+(defalias 'defmacro
+  (cons
+   'macro
+   #'(lambda (name arglist &optional docstring decl &rest body)
+       "Define NAME as a macro.
+When the macro is called, as in (NAME ARGS...),
+the function (lambda ARGLIST BODY...) is applied to
+the list ARGS... as it appears in the expression,
+and the result should be a form to be evaluated instead of the original.
+
+DECL is a declaration, optional, which can specify how to indent
+calls to this macro, how Edebug should handle it, and which argument
+should be treated as documentation.  It looks like this:
+  (declare SPECS...)
+The elements can look like this:
+  (indent INDENT)
+       Set NAME's `lisp-indent-function' property to INDENT.
+
+  (debug DEBUG)
+       Set NAME's `edebug-form-spec' property to DEBUG.  (This is
+       equivalent to writing a `def-edebug-spec' for the macro.)
+
+  (doc-string ELT)
+       Set NAME's `doc-string-elt' property to ELT."
+       (if (stringp docstring) nil
+         (if decl (setq body (cons decl body)))
+         (setq decl docstring)
+         (setq docstring nil))
+       (if (or (null decl) (eq 'declare (car-safe decl))) nil
+         (setq body (cons decl body))
+         (setq decl nil))
+       (if (null body) (setq body '(nil)))
+       (if docstring (setq body (cons docstring body)))
+       ;; Can't use backquote because it's not defined yet!
+       (let* ((fun (list 'function (cons 'lambda (cons arglist body))))
+              (def (list 'defalias
+                         (list 'quote name)
+                         (list 'cons ''macro fun))))
+         (if decl
+             (list 'progn
+                   (list 'funcall 'macro-declaration-function
+                         (list 'quote name)
+                         (list 'quote decl))
+                   def)
+           def)))))
+
+;; Now that we defined defmacro we can use it!
+(defmacro defun (name arglist &optional docstring &rest body)
+  "Define NAME as a function.
+The definition is (lambda ARGLIST [DOCSTRING] BODY...).
+See also the function `interactive'."
+  (declare (doc-string 3))
+  (if docstring (setq body (cons docstring body))
+    (if (null body) (setq body '(nil))))
+  (list 'defalias
+        (list 'quote name)
+        (list 'function
+              (cons 'lambda
+                    (cons arglist body)))))
 \f
 ;; Redefined in byte-optimize.el.
 ;; This is not documented--it's not clear that we should promote it.
index 2518d8359c3c0b60b61b87c714dfebbc3923e5d4..ce4d5d64ae2982b871325a390358f0f5b2b3b19a 100644 (file)
@@ -1169,12 +1169,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
              (t fn)))))))
 
 (defun byte-compile-arglist-signature (arglist)
-  (if (integerp arglist)
-      ;; New style byte-code arglist.
-      (cons (logand arglist 127)             ;Mandatory.
-            (if (zerop (logand arglist 128)) ;No &rest.
-                (lsh arglist -8)))           ;Nonrest.
-    ;; Old style byte-code, or interpreted function.
+  (cond
+   ;; New style byte-code arglist.
+   ((integerp arglist)
+    (cons (logand arglist 127)             ;Mandatory.
+          (if (zerop (logand arglist 128)) ;No &rest.
+              (lsh arglist -8))))          ;Nonrest.
+   ;; Old style byte-code, or interpreted function.
+   ((listp arglist)
     (let ((args 0)
           opts
           restp)
@@ -1190,7 +1192,9 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
                    (setq opts (1+ opts))
                 (setq args (1+ args)))))
         (setq arglist (cdr arglist)))
-      (cons args (if restp nil (if opts (+ args opts) args))))))
+      (cons args (if restp nil (if opts (+ args opts) args)))))
+   ;; Unknown arglist.
+   (t '(0))))
 
 
 (defun byte-compile-arglist-signatures-congruent-p (old new)
@@ -1250,8 +1254,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
     ;; and/or remember its arity if it's unknown.
     (or (and (or def (fboundp (car form))) ; might be a subr or autoload.
             (not (memq (car form) byte-compile-noruntime-functions)))
-       (eq (car form) byte-compile-current-form) ; ## this doesn't work
-                                       ; with recursion.
+       (eq (car form) byte-compile-current-form) ; ## This doesn't work
+                                                  ; with recursion.
        ;; It's a currently-undefined function.
        ;; Remember number of args in call.
        (let ((cons (assq (car form) byte-compile-unresolved-functions))
@@ -1316,9 +1320,8 @@ extra args."
 
 ;; Warn if the function or macro is being redefined with a different
 ;; number of arguments.
-(defun byte-compile-arglist-warn (form macrop)
-  (let* ((name (nth 1 form))
-         (old (byte-compile-fdefinition name macrop))
+(defun byte-compile-arglist-warn (name arglist macrop)
+  (let* ((old (byte-compile-fdefinition name macrop))
          (initial (and macrop
                        (cdr (assq name
                                   byte-compile-initial-macro-environment)))))
@@ -1337,12 +1340,12 @@ extra args."
                          (`(closure ,_ ,args . ,_) args)
                          ((pred byte-code-function-p) (aref old 0))
                          (t '(&rest def)))))
-               (sig2 (byte-compile-arglist-signature (nth 2 form))))
+               (sig2 (byte-compile-arglist-signature arglist)))
            (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
              (byte-compile-set-symbol-position name)
              (byte-compile-warn
               "%s %s used to take %s %s, now takes %s"
-              (if (eq (car form) 'defun) "function" "macro")
+              (if macrop "macro" "function")
               name
               (byte-compile-arglist-signature-string sig1)
               (if (equal sig1 '(1 . 1)) "argument" "arguments")
@@ -1356,7 +1359,7 @@ extra args."
                          'byte-compile-inline-expand))
             (byte-compile-warn "defsubst `%s' was used before it was defined"
                       name))
-          (setq sig (byte-compile-arglist-signature (nth 2 form))
+          (setq sig (byte-compile-arglist-signature arglist)
                 nums (sort (copy-sequence (cdr calls)) (function <))
                 min (car nums)
                 max (car (nreverse nums)))
@@ -2021,31 +2024,30 @@ Call from the source buffer."
        ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))))
 
 (defun byte-compile-output-file-form (form)
-  ;; writes the given form to the output buffer, being careful of docstrings
+  ;; Write the given form to the output buffer, being careful of docstrings
   ;; in defun, defmacro, defvar, defvaralias, defconst, autoload and
   ;; custom-declare-variable because make-docfile is so amazingly stupid.
   ;; defalias calls are output directly by byte-compile-file-form-defmumble;
   ;; it does not pay to first build the defalias in defmumble and then parse
   ;; it here.
-  (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst
-                                    autoload custom-declare-variable))
-          (stringp (nth 3 form)))
-      (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
-                                  (memq (car form)
-                                        '(defvaralias autoload
-                                          custom-declare-variable)))
-    (let ((print-escape-newlines t)
-         (print-length nil)
-         (print-level nil)
-         (print-quoted t)
-         (print-gensym t)
-         (print-circle              ; handle circular data structures
-          (not byte-compile-disable-print-circle)))
+  (let ((print-escape-newlines t)
+        (print-length nil)
+        (print-level nil)
+        (print-quoted t)
+        (print-gensym t)
+        (print-circle                   ; Handle circular data structures.
+         (not byte-compile-disable-print-circle)))
+    (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst
+                                      autoload custom-declare-variable))
+             (stringp (nth 3 form)))
+        (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
+                                     (memq (car form)
+                                           '(defvaralias autoload
+                                              custom-declare-variable)))
       (princ "\n" byte-compile--outbuffer)
       (prin1 form byte-compile--outbuffer)
       nil)))
 
-(defvar print-gensym-alist)            ;Used before print-circle existed.
 (defvar byte-compile--for-effect)
 
 (defun byte-compile-output-docform (preface name info form specindex quoted)
@@ -2075,7 +2077,6 @@ list that represents a doc string reference.
                (setq position
                      (byte-compile-output-as-comment
                       (nth (nth 1 info) form) nil))
-               (setq position (- (position-bytes position) (point-min) -1))
                ;; If the doc string starts with * (a user variable),
                ;; negate POSITION.
                (if (and (stringp (nth (nth 1 info) form))
@@ -2088,17 +2089,7 @@ list that represents a doc string reference.
               (insert preface)
               (prin1 name byte-compile--outbuffer)))
         (insert (car info))
-        (let ((print-escape-newlines t)
-              (print-quoted t)
-              ;; For compatibility with code before print-circle,
-              ;; use a cons cell to say that we want
-              ;; print-gensym-alist not to be cleared
-              ;; between calls to print functions.
-              (print-gensym '(t))
-              (print-circle             ; handle circular data structures
-               (not byte-compile-disable-print-circle))
-              print-gensym-alist     ; was used before print-circle existed.
-              (print-continuous-numbering t)
+        (let ((print-continuous-numbering t)
               print-number-table
               (index 0))
           (prin1 (car form) byte-compile--outbuffer)
@@ -2121,8 +2112,6 @@ list that represents a doc string reference.
                           (byte-compile-output-as-comment
                            (cons (car form) (nth 1 form))
                            t)))
-                     (setq position (- (position-bytes position)
-                                       (point-min) -1))
                      (princ (format "(#$ . %d) nil" position)
                             byte-compile--outbuffer)
                      (setq form (cdr form))
@@ -2317,143 +2306,132 @@ list that represents a doc string reference.
       (nth 1 (nth 1 form))
     (byte-compile-keep-pending form)))
 
-(put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun)
-(defun byte-compile-file-form-defun (form)
-  (byte-compile-file-form-defmumble form nil))
-
-(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro)
-(defun byte-compile-file-form-defmacro (form)
-  (byte-compile-file-form-defmumble form t))
-
-(defun byte-compile-defmacro-declaration (form)
-  "Generate code for declarations in macro definitions.
-Remove declarations from the body of the macro definition
-by side-effects."
-  (let ((tail (nthcdr 2 form))
-        (res '()))
-    (when (stringp (car (cdr tail)))
-      (setq tail (cdr tail)))
-    (while (and (consp (car (cdr tail)))
-                (eq (car (car (cdr tail))) 'declare))
-      (let ((declaration (car (cdr tail))))
-        (setcdr tail (cdr (cdr tail)))
-        (push `(if macro-declaration-function
-                   (funcall macro-declaration-function
-                            ',(car (cdr form)) ',declaration))
-              res)))
-    res))
-
-(defun byte-compile-file-form-defmumble (form macrop)
-  (let* ((name (car (cdr form)))
-        (this-kind (if macrop 'byte-compile-macro-environment
-                     'byte-compile-function-environment))
-        (that-kind (if macrop 'byte-compile-function-environment
-                     'byte-compile-macro-environment))
-        (this-one (assq name (symbol-value this-kind)))
-        (that-one (assq name (symbol-value that-kind)))
-        (byte-compile-free-references nil)
-        (byte-compile-free-assignments nil))
+(defun byte-compile-file-form-defmumble (name macro arglist body rest)
+  "Process a `defalias' for NAME.
+If MACRO is non-nil, the definition is known to be a macro.
+ARGLIST is the list of arguments, if it was recognized or t otherwise.
+BODY of the definition, or t if not recognized.
+Return non-nil if everything went as planned, or nil to imply that it decided
+not to take responsibility for the actual compilation of the code."
+  (let* ((this-kind (if macro 'byte-compile-macro-environment
+                      'byte-compile-function-environment))
+         (that-kind (if macro 'byte-compile-function-environment
+                      'byte-compile-macro-environment))
+         (this-one (assq name (symbol-value this-kind)))
+         (that-one (assq name (symbol-value that-kind)))
+         (byte-compile-current-form name)) ; For warnings.
+
     (byte-compile-set-symbol-position name)
     ;; When a function or macro is defined, add it to the call tree so that
     ;; we can tell when functions are not used.
     (if byte-compile-generate-call-tree
-       (or (assq name byte-compile-call-tree)
-           (setq byte-compile-call-tree
-                 (cons (list name nil nil) byte-compile-call-tree))))
+        (or (assq name byte-compile-call-tree)
+            (setq byte-compile-call-tree
+                  (cons (list name nil nil) byte-compile-call-tree))))
 
-    (setq byte-compile-current-form name) ; for warnings
     (if (byte-compile-warning-enabled-p 'redefine)
-       (byte-compile-arglist-warn form macrop))
+        (byte-compile-arglist-warn name arglist macro))
+
     (if byte-compile-verbose
-       (message "Compiling %s... (%s)"
-                 (or byte-compile-current-file "") (nth 1 form)))
-    (cond (that-one
-          (if (and (byte-compile-warning-enabled-p 'redefine)
-                   ;; don't warn when compiling the stubs in byte-run...
-                   (not (assq (nth 1 form)
-                              byte-compile-initial-macro-environment)))
-              (byte-compile-warn
+        (message "Compiling %s... (%s)"
+                 (or byte-compile-current-file "") name))
+    (cond ((not (or macro (listp body)))
+           ;; We do not know positively if the definition is a macro
+           ;; or a function, so we shouldn't emit warnings.
+           ;; This also silences "multiple definition" warnings for defmethods.
+           nil)
+          (that-one
+           (if (and (byte-compile-warning-enabled-p 'redefine)
+                    ;; Don't warn when compiling the stubs in byte-run...
+                    (not (assq name byte-compile-initial-macro-environment)))
+               (byte-compile-warn
                 "`%s' defined multiple times, as both function and macro"
-                (nth 1 form)))
-          (setcdr that-one nil))
-         (this-one
-          (when (and (byte-compile-warning-enabled-p 'redefine)
-                      ;; hack: don't warn when compiling the magic internal
+                name))
+           (setcdr that-one nil))
+          (this-one
+           (when (and (byte-compile-warning-enabled-p 'redefine)
+                      ;; Hack: Don't warn when compiling the magic internal
                       ;; byte-compiler macros in byte-run.el...
-                      (not (assq (nth 1 form)
-                                 byte-compile-initial-macro-environment)))
-            (byte-compile-warn "%s `%s' defined multiple times in this file"
-                               (if macrop "macro" "function")
-                               (nth 1 form))))
-         ((and (fboundp name)
-               (eq (car-safe (symbol-function name))
-                   (if macrop 'lambda 'macro)))
-          (when (byte-compile-warning-enabled-p 'redefine)
-            (byte-compile-warn "%s `%s' being redefined as a %s"
-                               (if macrop "function" "macro")
-                               (nth 1 form)
-                               (if macrop "macro" "function")))
-          ;; shadow existing definition
-          (set this-kind
-               (cons (cons name nil)
-                     (symbol-value this-kind))))
-         )
-    (let ((body (nthcdr 3 form)))
-      (when (and (stringp (car body))
-                (symbolp (car-safe (cdr-safe body)))
-                (car-safe (cdr-safe body))
-                (stringp (car-safe (cdr-safe (cdr-safe body)))))
-       (byte-compile-set-symbol-position (nth 1 form))
-       (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
-                          (nth 1 form))))
-
-    ;; Generate code for declarations in macro definitions.
-    ;; Remove declarations from the body of the macro definition.
-    (when macrop
-      (dolist (decl (byte-compile-defmacro-declaration form))
-        (prin1 decl byte-compile--outbuffer)))
-
-    (let* ((code (byte-compile-lambda (nthcdr 2 form) t)))
-      (if this-one
-         ;; A definition in b-c-initial-m-e should always take precedence
-         ;; during compilation, so don't let it be redefined.  (Bug#8647)
-         (or (and macrop
-                  (assq name byte-compile-initial-macro-environment))
-             (setcdr this-one code))
-       (set this-kind
-            (cons (cons name code)
-                  (symbol-value this-kind))))
-      (byte-compile-flush-pending)
-      (if (not (stringp (nth 3 form)))
-          ;; No doc string.  Provide -1 as the "doc string index"
-          ;; so that no element will be treated as a doc string.
-          (byte-compile-output-docform
-           "\n(defalias '"
-           name
-           (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))
-           (append code nil)            ; Turn byte-code-function-p into list.
-           (and (atom code) byte-compile-dynamic
-                1)
-           nil)
-        ;; Output the form by hand, that's much simpler than having
-        ;; b-c-output-file-form analyze the defalias.
-        (byte-compile-output-docform
-         "\n(defalias '"
-         name
-         (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))
-         (append code nil)              ; Turn byte-code-function-p into list.
-         (and (atom code) byte-compile-dynamic
-              1)
-         nil))
-      (princ ")" byte-compile--outbuffer)
-      nil)))
+                      (not (assq name byte-compile-initial-macro-environment)))
+             (byte-compile-warn "%s `%s' defined multiple times in this file"
+                                (if macro "macro" "function")
+                                name)))
+          ((and (fboundp name)
+                (eq (car-safe (symbol-function name))
+                    (if macro 'lambda 'macro)))
+           (when (byte-compile-warning-enabled-p 'redefine)
+             (byte-compile-warn "%s `%s' being redefined as a %s"
+                                (if macro "function" "macro")
+                                name
+                                (if macro "macro" "function")))
+           ;; Shadow existing definition.
+           (set this-kind
+                (cons (cons name nil)
+                      (symbol-value this-kind))))
+          )
+
+    (when (and (listp body)
+               (stringp (car body))
+               (symbolp (car-safe (cdr-safe body)))
+               (car-safe (cdr-safe body))
+               (stringp (car-safe (cdr-safe (cdr-safe body)))))
+      ;; FIXME: We've done that already just above, so this looks wrong!
+      ;;(byte-compile-set-symbol-position name)
+      (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
+                         name))
+    
+    (if (not (listp body))
+        ;; The precise definition requires evaluation to find out, so it
+        ;; will only be known at runtime.
+        ;; For a macro, that means we can't use that macro in the same file.
+        (progn
+          (unless macro
+            (push (cons name (if (listp arglist) `(declared ,arglist) t))
+                  byte-compile-function-environment))
+          ;; Tell the caller that we didn't compile it yet.
+          nil)
+
+      (let* ((code (byte-compile-lambda (cons arglist body) t)))
+        (if this-one
+            ;; A definition in b-c-initial-m-e should always take precedence
+            ;; during compilation, so don't let it be redefined.  (Bug#8647)
+            (or (and macro
+                     (assq name byte-compile-initial-macro-environment))
+                (setcdr this-one code))
+          (set this-kind
+               (cons (cons name code)
+                     (symbol-value this-kind))))
+
+        (if rest
+            ;; There are additional args to `defalias' (like maybe a docstring)
+            ;; that the code below can't handle: punt!
+            nil
+          ;; Otherwise, we have a bona-fide defun/defmacro definition, and use
+          ;; special code to allow dynamic docstrings and byte-code.
+          (byte-compile-flush-pending)
+          (let ((index
+                 ;; If there's no doc string, provide -1 as the "doc string
+                 ;; index" so that no element will be treated as a doc string.
+                 (if (not (stringp (car body))) -1 4)))
+            ;; Output the form by hand, that's much simpler than having
+            ;; b-c-output-file-form analyze the defalias.
+            (byte-compile-output-docform
+             "\n(defalias '"
+             name
+             (if macro `(" '(macro . #[" ,index "])") `(" #[" ,index "]"))
+             (append code nil)          ; Turn byte-code-function-p into list.
+             (and (atom code) byte-compile-dynamic
+                  1)
+             nil))
+          (princ ")" byte-compile--outbuffer)
+          t)))))
 
-;; Print Lisp object EXP in the output file, inside a comment,
-;; and return the file position it will have.
-;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
 (defun byte-compile-output-as-comment (exp quoted)
-  (let ((position (point)))
-    (with-current-buffer byte-compile--outbuffer
+  "Print Lisp object EXP in the output file, inside a comment,
+and return the file (byte) position it will have.
+If QUOTED is non-nil, print with quoting; otherwise, print without quoting."
+  (with-current-buffer byte-compile--outbuffer
+    (let ((position (point)))
 
       ;; Insert EXP, and make it a comment with #@LENGTH.
       (insert " ")
@@ -2478,13 +2456,12 @@ by side-effects."
                                    (position-bytes position))))
 
       ;; Save the file position of the object.
-      ;; Note we should add 1 to skip the space
-      ;; that we inserted before the actual doc string,
-      ;; and subtract 1 to convert from an 1-origin Emacs position
-      ;; to a file position; they cancel.
-      (setq position (point))
-      (goto-char (point-max)))
-    position))
+      ;; Note we add 1 to skip the space that we inserted before the actual doc
+      ;; string, and subtract point-min to convert from an 1-origin Emacs
+      ;; position to a file position.
+      (prog1
+          (- (position-bytes (point)) (point-min) -1)
+        (goto-char (point-max))))))
 
 
 \f
@@ -2581,14 +2558,15 @@ If FORM is a lambda or a macro, byte-compile it as a function."
               (lsh nonrest 8)
               (lsh rest 7)))))
 
-;; Byte-compile a lambda-expression and return a valid function.
-;; The value is usually a compiled function but may be the original
-;; lambda-expression.
-;; When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
-;; of the list FUN and `byte-compile-set-symbol-position' is not called.
-;; Use this feature to avoid calling `byte-compile-set-symbol-position'
-;; for symbols generated by the byte compiler itself.
+
 (defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
+  "Byte-compile a lambda-expression and return a valid function.
+The value is usually a compiled function but may be the original
+lambda-expression.
+When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
+of the list FUN and `byte-compile-set-symbol-position' is not called.
+Use this feature to avoid calling `byte-compile-set-symbol-position'
+for symbols generated by the byte compiler itself."
   (if add-lambda
       (setq fun (cons 'lambda fun))
     (unless (eq 'lambda (car-safe fun))
@@ -2649,24 +2627,23 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                                         (byte-compile-make-lambda-lexenv fun))
                                    reserved-csts)))
       ;; Build the actual byte-coded function.
-      (if (eq 'byte-code (car-safe compiled))
-          (apply 'make-byte-code
-                 (if lexical-binding
-                     (byte-compile-make-args-desc arglist)
-                   arglist)
-                 (append
-                  ;; byte-string, constants-vector, stack depth
-                  (cdr compiled)
-                  ;; optionally, the doc string.
-                  (cond (lexical-binding
-                         (require 'help-fns)
-                         (list (help-add-fundoc-usage doc arglist)))
-                        ((or doc int)
-                         (list doc)))
-                  ;; optionally, the interactive spec.
-                  (if int
-                      (list (nth 1 int)))))
-        (error "byte-compile-top-level did not return byte-code")))))
+      (assert (eq 'byte-code (car-safe compiled)))
+      (apply #'make-byte-code
+             (if lexical-binding
+                 (byte-compile-make-args-desc arglist)
+               arglist)
+             (append
+              ;; byte-string, constants-vector, stack depth
+              (cdr compiled)
+              ;; optionally, the doc string.
+              (cond (lexical-binding
+                     (require 'help-fns)
+                     (list (help-add-fundoc-usage doc arglist)))
+                    ((or doc int)
+                     (list doc)))
+              ;; optionally, the interactive spec.
+              (if int
+                  (list (nth 1 int))))))))
 
 (defvar byte-compile-reserved-constants 0)
 
@@ -3066,9 +3043,9 @@ That command is designed for interactive use only" fn))
   (byte-compile-check-variable var 'assign)
   (let ((lex-binding (assq var byte-compile--lexical-environment)))
     (if lex-binding
-       ;; VAR is lexically bound
+       ;; VAR is lexically bound.
         (byte-compile-stack-set (cdr lex-binding))
-      ;; VAR is dynamically bound
+      ;; VAR is dynamically bound.
       (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
                  (boundp var)
                  (memq var byte-compile-bound-variables)
@@ -3353,6 +3330,7 @@ discarding."
            (body (nthcdr 3 form))
            (fun
             (byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
+      (assert (> (length env) 0))       ;Otherwise, we don't need a closure.
       (assert (byte-code-function-p fun))
       (byte-compile-form `(make-byte-code
                            ',(aref fun 0) ',(aref fun 1)
@@ -4074,36 +4052,11 @@ binding slots have been popped."
 \f
 ;;; top-level forms elsewhere
 
-(byte-defop-compiler-1 defun)
-(byte-defop-compiler-1 defmacro)
 (byte-defop-compiler-1 defvar)
 (byte-defop-compiler-1 defconst byte-compile-defvar)
 (byte-defop-compiler-1 autoload)
 (byte-defop-compiler-1 lambda byte-compile-lambda-form)
 
-(defun byte-compile-defun (form)
-  ;; This is not used for file-level defuns with doc strings.
-  (if (symbolp (car form))
-      (byte-compile-set-symbol-position (car form))
-    (byte-compile-set-symbol-position 'defun)
-    (error "defun name must be a symbol, not %s" (car form)))
-  (byte-compile-push-constant 'defalias)
-  (byte-compile-push-constant (nth 1 form))
-  (byte-compile-push-constant (byte-compile-lambda (cdr (cdr form)) t))
-  (byte-compile-out 'byte-call 2))
-
-(defun byte-compile-defmacro (form)
-  ;; This is not used for file-level defmacros with doc strings.
-  (byte-compile-body-do-effect
-   (let ((decls (byte-compile-defmacro-declaration form))
-         (code (byte-compile-lambda (cdr (cdr form)) t)))
-     `((defalias ',(nth 1 form)
-         ,(if (eq (car-safe code) 'make-byte-code)
-              `(cons 'macro ,code)
-            `'(macro . ,(eval code))))
-       ,@decls
-       ',(nth 1 form)))))
-
 ;; If foo.el declares `toto' as obsolete, it is likely that foo.el will
 ;; actually use `toto' in order for this obsolete variable to still work
 ;; correctly, so paradoxically, while byte-compiling foo.el, the presence
@@ -4179,38 +4132,53 @@ binding slots have been popped."
 (put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias)
 ;; Used for eieio--defalias as well.
 (defun byte-compile-file-form-defalias (form)
-  (if (and (consp (cdr form)) (consp (nth 1 form))
-          (eq (car (nth 1 form)) 'quote)
-          (consp (cdr (nth 1 form)))
-          (symbolp (nth 1 (nth 1 form))))
-      (let ((constant
-            (and (consp (nthcdr 2 form))
-                 (consp (nth 2 form))
-                 (eq (car (nth 2 form)) 'quote)
-                 (consp (cdr (nth 2 form)))
-                 (symbolp (nth 1 (nth 2 form))))))
-       (byte-compile-defalias-warn (nth 1 (nth 1 form)))
-       (push (cons (nth 1 (nth 1 form))
-                   (if constant (nth 1 (nth 2 form)) t))
-             byte-compile-function-environment)))
-  ;; We used to just do: (byte-compile-normal-call form)
-  ;; But it turns out that this fails to optimize the code.
-  ;; So instead we now do the same as what other byte-hunk-handlers do,
-  ;; which is to call back byte-compile-file-form and then return nil.
-  ;; Except that we can't just call byte-compile-file-form since it would
-  ;; call us right back.
-  (byte-compile-keep-pending form)
-  ;; Return nil so the form is not output twice.
-  nil)
-
-;; Turn off warnings about prior calls to the function being defalias'd.
-;; This could be smarter and compare those calls with
-;; the function it is being aliased to.
-(defun byte-compile-defalias-warn (new)
-  (let ((calls (assq new byte-compile-unresolved-functions)))
-    (if calls
-       (setq byte-compile-unresolved-functions
-             (delq calls byte-compile-unresolved-functions)))))
+  ;; For the compilation itself, we could largely get rid of this hunk-handler,
+  ;; if it weren't for the fact that we need to figure out when a defalias
+  ;; defines a macro, so as to add it to byte-compile-macro-environment.
+  ;;
+  ;; FIXME: we also use this hunk-handler to implement the function's dynamic
+  ;; docstring feature.  We could actually implement it more elegantly in
+  ;; byte-compile-lambda so it applies to all lambdas, but the problem is that
+  ;; the resulting .elc format will not be recognized by make-docfile, so
+  ;; either we stop using DOC for the docstrings of preloaded elc files (at the
+  ;; cost of around 24KB on 32bit hosts, double on 64bit hosts) or we need to
+  ;; build DOC in a more clever way (e.g. handle anonymous elements).
+  (let ((byte-compile-free-references nil)
+        (byte-compile-free-assignments nil))
+    (pcase form
+      ;; Decompose `form' into:
+      ;; - `name' is the name of the defined function.
+      ;; - `arg' is the expression to which it is defined.
+      ;; - `rest' is the rest of the arguments.
+      (`(,_ ',name ,arg . ,rest)
+       (pcase-let*
+           ;; `macro' is non-nil if it defines a macro.
+           ;; `fun' is the function part of `arg' (defaults to `arg').
+           (((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let macro t))
+                 (and (let fun arg) (let macro nil)))
+             arg)
+            ;; `lam' is the lambda expression in `fun' (or nil if not
+            ;; recognized).
+            ((or `(,(or `quote `function) ,lam) (let lam nil))
+             fun)
+            ;; `arglist' is the list of arguments (or t if not recognized).
+            ;; `body' is the body of `lam' (or t if not recognized).
+            ((or `(lambda ,arglist . ,body)
+                 ;; `(closure ,_ ,arglist . ,body)
+                 (and `(internal-make-closure ,arglist . ,_) (let body t))
+                 (and (let arglist t) (let body t)))
+             lam))
+         (unless (byte-compile-file-form-defmumble
+                  name macro arglist body rest)
+           (byte-compile-keep-pending form))))
+
+      ;; We used to just do: (byte-compile-normal-call form)
+      ;; But it turns out that this fails to optimize the code.
+      ;; So instead we now do the same as what other byte-hunk-handlers do,
+      ;; which is to call back byte-compile-file-form and then return nil.
+      ;; Except that we can't just call byte-compile-file-form since it would
+      ;; call us right back.
+      (t (byte-compile-keep-pending form)))))
 
 (byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
 (defun byte-compile-no-warnings (form)
index 3ce0eadab55a24e9ddba57c37ea8db02fa38c0f0..f43dd9e7ee4d603be6932a6bee32cef36460881e 100644 (file)
@@ -73,8 +73,6 @@
 ;;   since afterwards they can because obnoxious (warnings about an "unused
 ;;   variable" should not be emitted when the variable use has simply been
 ;;   optimized away).
-;; - turn defun and defmacro into macros (and remove special handling of
-;;   `declare' afterwards).
 ;; - let macros specify that some let-bindings come from the same source,
 ;;   so the unused warning takes all uses into account.
 ;; - let interactive specs return a function to build the args (to stash into
@@ -410,20 +408,6 @@ places where they originally did not directly appear."
             . ,(mapcar (lambda (form) (cconv-convert form env extend))
                        forms)))
 
-                                       ;defun, defmacro
-    (`(,(and sym (or `defun `defmacro))
-       ,func ,args . ,body)
-     (assert (equal body (caar cconv-freevars-alist)))
-     (assert (null (cdar cconv-freevars-alist)))
-
-     (let ((new (cconv--convert-function args body env form)))
-       (pcase new
-         (`(function (lambda ,newargs . ,new-body))
-          (assert (equal args newargs))
-          `(,sym ,func ,args . ,new-body))
-         (t (byte-compile-report-error
-             (format "Internal error in cconv of (%s %s ...)" sym func))))))
-
                                        ;condition-case
     (`(condition-case ,var ,protected-form . ,handlers)
      (let ((newform (cconv--convert-function
@@ -618,15 +602,6 @@ and updates the data stored in ENV."
        (dolist (vardata newvars)
          (cconv--analyse-use vardata form "variable"))))
 
-                                       ; defun special form
-    (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms)
-     (when env
-       (byte-compile-log-warning
-        (format "Function %S will ignore its context %S"
-                func (mapcar #'car env))
-        t :warning))
-     (cconv--analyse-function vrs body-forms nil form))
-
     (`(function (lambda ,vrs . ,body-forms))
      (cconv--analyse-function vrs body-forms env form))
 
index 5b82cd477f9be19cee31ad18a7267f584ce0aac5..82e958533e8b69fbaf7d2586a24e37fc0494bc39 100644 (file)
@@ -357,6 +357,8 @@ Returns the forms."
     (set (make-local-variable 'elint-buffer-env)
         (elint-init-env elint-buffer-forms))
     (if elint-preloaded-env
+        ;; FIXME: This doesn't do anything!  Should we setq the result to
+        ;; elint-buffer-env?
        (elint-env-add-env elint-preloaded-env elint-buffer-env))
     (set (make-local-variable 'elint-last-env-time) (buffer-modified-tick))
     elint-buffer-forms))
index 973d57d421077536e1461bfd0c850e136f632bd1..2a4cd704a43afd9f91972789dac5dad15038854d 100644 (file)
@@ -135,11 +135,9 @@ It has `lisp-mode-abbrev-table' as its parent."
 
 ;; This was originally in autoload.el and is still used there.
 (put 'autoload 'doc-string-elt 3)
-(put 'defun    'doc-string-elt 3)
 (put 'defmethod 'doc-string-elt 3)
 (put 'defvar   'doc-string-elt 3)
 (put 'defconst 'doc-string-elt 3)
-(put 'defmacro 'doc-string-elt 3)
 (put 'defalias 'doc-string-elt 3)
 (put 'defvaralias 'doc-string-elt 3)
 (put 'define-category 'doc-string-elt 2)
index 21c351159c297169c0da02c5948ca66a8a6a18f9..ba8f9c4c1483f529194f6ca058950edbeee899b0 100644 (file)
@@ -65,7 +65,7 @@ result will be eq to LIST).
            (,unshared nil)
            (,tail ,shared)
            ,var ,new-el)
-       (while ,tail
+       (while (consp ,tail)
         (setq ,var (car ,tail)
               ,new-el (progn ,@body))
         (unless (eq ,var ,new-el)
@@ -128,20 +128,6 @@ Assumes the caller has bound `macroexpand-all-environment'."
                                 (cddr form))
                     (cdr form))
         form))
-      (`(defmacro ,name . ,args-and-body)
-       (push (cons name (cons 'lambda args-and-body))
-             macroexpand-all-environment)
-       (let ((n 3))
-         ;; Don't macroexpand `declare' since it should really be "expanded"
-         ;; away when `defmacro' is expanded, but currently defmacro is not
-         ;; itself a macro.  So both `defmacro' and `declare' need to be
-         ;; handled directly in bytecomp.el.
-         ;; FIXME: Maybe a simpler solution is to (defalias 'declare 'quote).
-         (while (or (stringp (nth n form))
-                    (eq (car-safe (nth n form)) 'declare))
-           (setq n (1+ n)))
-         (macroexpand-all-forms form n)))
-      (`(defun . ,_) (macroexpand-all-forms form 3))
       (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2))
       (`(function ,(and f `(lambda . ,_)))
        (maybe-cons 'function
index c5180e9ff6ce13bca27c1d278f16e804e87a53e6..fae742f6638ea632966ef28870a859d64e5cf4f1 100644 (file)
 ;; At this point, we're ready to resume undo recording for scratch.
 (buffer-enable-undo "*scratch*")
 
+(when (hash-table-p purify-flag)
+  (let ((strings 0)
+        (vectors 0)
+        (conses 0)
+        (others 0))
+    (maphash (lambda (k v)
+               (cond
+                ((stringp k) (setq strings (1+ strings)))
+                ((vectorp k) (setq vectors (1+ vectors)))
+                ((consp k)   (setq conses  (1+ conses)))
+                (t           (setq others  (1+ others)))))
+             purify-flag)
+    (message "Pure-hashed: %d strings, %d vectors, %d conses, %d others"
+             strings vectors conses others)))
+
 ;; Avoid error if user loads some more libraries now and make sure the
 ;; hash-consing hash table is GC'd.
 (setq purify-flag nil)
index e39ec206bf886501015803ca893232fdb9ef3868..0c050535d8ef3d3d3090c9a371d1639eae7432a1 100644 (file)
@@ -1,3 +1,13 @@
+2012-05-30  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * eval.c (Fdefun, Fdefmacro, Vmacro_declaration_function):
+       Move to byte-run.el.
+       (Fautoload): Do the hash-doc more carefully.
+       * data.c (Fdefalias): Purify definition, except for keymaps.
+       (Qdefun): Move from eval.c.
+       * lisp.h (Qdefun): Remove.
+       * lread.c (read1): Tiny simplification.
+
 2012-05-29  Troels Nielsen  <bn.troels@gmail.com>
 
        Do not create empty overlays with the evaporate property (Bug#9642).
@@ -11,8 +21,8 @@
 
        * w32term.c (my_bring_window_to_top): New function.
        (x_raise_frame): Use handle returned by DeferWindowPos, which
-       could be different from the original one.  Call
-       my_bring_window_to_top instead of my_set_foreground_window.
+       could be different from the original one.
+       Call my_bring_window_to_top instead of my_set_foreground_window.
        (Bug#11513)
 
        * w32fns.c (w32_wnd_proc): Accept and process WM_EMACS_BRINGTOTOP
 2012-05-26  Eli Zaretskii  <eliz@gnu.org>
 
        Extend mouse support on W32 text-mode console.
-       * xdisp.c (draw_row_with_mouse_face): Call
-       tty_draw_row_with_mouse_face for WINDOWSNT as well.
+       * xdisp.c (draw_row_with_mouse_face):
+       Call tty_draw_row_with_mouse_face for WINDOWSNT as well.
 
        * w32console.c: Include window.h.
-       (w32con_write_glyphs_with_face, tty_draw_row_with_mouse_face): New
-       functions.
+       (w32con_write_glyphs_with_face, tty_draw_row_with_mouse_face):
+       New functions.
        (initialize_w32_display): Initialize mouse-highlight data.
 
        * w32inevt.c: Include termchar.h and window.h.
        (marker_byte_position, Fbuffer_has_markers_at):
        Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough.
        (Fset_marker, set_marker_restricted): Don't assume fixnum fits in int.
-       * menu.c (ensure_menu_items): Renamed from grow_menu_items.
+       * menu.c (ensure_menu_items): Rename from grow_menu_items.
        It now merely ensures that the menu is large enough, without
        necessarily growing it, as this avoids some integer overflow issues.
        All callers changed.
 
        * xdisp.c (handle_single_display_spec): Return 1 for left-margin
        and right-margin display specs even if the spec is invalid or we
-       are on a TTY, and thus unable to display on the fringes.  That's
-       because the text with the property will not be displayed anyway,
+       are on a TTY, and thus unable to display on the fringes.
+       That's because the text with the property will not be displayed anyway,
        so we need to signal to the caller that this is a "replacing"
        display spec.  This fixes display when the spec is invalid or we
        are on a TTY.
index 11660a2483d6f0d4187bac9189cc10e899384962..defcd06a2edbfe2c5b362e18e83787b84d6723cb 100644 (file)
@@ -34,6 +34,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "syssignal.h"
 #include "termhooks.h"  /* For FRAME_KBOARD reference in y-or-n-p.  */
 #include "font.h"
+#include "keymap.h"
 
 #include <float.h>
 /* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*.  */
@@ -92,6 +93,7 @@ Lisp_Object Qbuffer;
 static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
 static Lisp_Object Qsubrp, Qmany, Qunevalled;
 Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
+static Lisp_Object Qdefun;
 
 Lisp_Object Qinteractive_form;
 
@@ -130,7 +132,7 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
 }
 
 \f
-/* Data type predicates */
+/* Data type predicates */
 
 DEFUN ("eq", Feq, Seq, 2, 2, 0,
        doc: /* Return t if the two args are the same Lisp object.  */)
@@ -656,6 +658,10 @@ determined by DEFINITION.  */)
   if (CONSP (XSYMBOL (symbol)->function)
       && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
     LOADHIST_ATTACH (Fcons (Qt, symbol));
+  if (!NILP (Vpurify_flag)
+      /* If `definition' is a keymap, immutable (and copying) is wrong.  */
+      && !KEYMAPP (definition))
+    definition = Fpurecopy (definition);
   definition = Ffset (symbol, definition);
   LOADHIST_ATTACH (Fcons (Qdefun, symbol));
   if (!NILP (docstring))
@@ -3085,6 +3091,8 @@ syms_of_data (void)
   DEFSYM (Qbool_vector, "bool-vector");
   DEFSYM (Qhash_table, "hash-table");
 
+  DEFSYM (Qdefun, "defun");
+
   DEFSYM (Qfont_spec, "font-spec");
   DEFSYM (Qfont_entity, "font-entity");
   DEFSYM (Qfont_object, "font-object");
index e44b7e329158fd28ccd79033adafbcb333d06d22..1da841a4073d03ee36fcef1b88b9a161820dcc2e 100644 (file)
@@ -65,7 +65,7 @@ struct handler *handlerlist;
 int gcpro_level;
 #endif
 
-Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
+Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp;
 Lisp_Object Qinhibit_quit;
 Lisp_Object Qand_rest;
 static Lisp_Object Qand_optional;
@@ -593,109 +593,6 @@ interactive_p (int exclude_subrs_p)
 }
 
 
-DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0,
-       doc: /* Define NAME as a function.
-The definition is (lambda ARGLIST [DOCSTRING] BODY...).
-See also the function `interactive'.
-usage: (defun NAME ARGLIST [DOCSTRING] BODY...)  */)
-  (Lisp_Object args)
-{
-  register Lisp_Object fn_name;
-  register Lisp_Object defn;
-
-  fn_name = Fcar (args);
-  CHECK_SYMBOL (fn_name);
-  defn = Fcons (Qlambda, Fcdr (args));
-  if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization!  */
-    defn = Ffunction (Fcons (defn, Qnil));
-  if (!NILP (Vpurify_flag))
-    defn = Fpurecopy (defn);
-  if (CONSP (XSYMBOL (fn_name)->function)
-      && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
-    LOADHIST_ATTACH (Fcons (Qt, fn_name));
-  Ffset (fn_name, defn);
-  LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
-  return fn_name;
-}
-
-DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
-       doc: /* Define NAME as a macro.
-The actual definition looks like
- (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
-When the macro is called, as in (NAME ARGS...),
-the function (lambda ARGLIST BODY...) is applied to
-the list ARGS... as it appears in the expression,
-and the result should be a form to be evaluated instead of the original.
-
-DECL is a declaration, optional, which can specify how to indent
-calls to this macro, how Edebug should handle it, and which argument
-should be treated as documentation.  It looks like this:
-  (declare SPECS...)
-The elements can look like this:
-  (indent INDENT)
-       Set NAME's `lisp-indent-function' property to INDENT.
-
-  (debug DEBUG)
-       Set NAME's `edebug-form-spec' property to DEBUG.  (This is
-       equivalent to writing a `def-edebug-spec' for the macro.)
-
-  (doc-string ELT)
-       Set NAME's `doc-string-elt' property to ELT.
-
-usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
-  (Lisp_Object args)
-{
-  register Lisp_Object fn_name;
-  register Lisp_Object defn;
-  Lisp_Object lambda_list, doc, tail;
-
-  fn_name = Fcar (args);
-  CHECK_SYMBOL (fn_name);
-  lambda_list = Fcar (Fcdr (args));
-  tail = Fcdr (Fcdr (args));
-
-  doc = Qnil;
-  if (STRINGP (Fcar (tail)))
-    {
-      doc = XCAR (tail);
-      tail = XCDR (tail);
-    }
-
-  if (CONSP (Fcar (tail))
-      && EQ (Fcar (Fcar (tail)), Qdeclare))
-    {
-      if (!NILP (Vmacro_declaration_function))
-       {
-         struct gcpro gcpro1;
-         GCPRO1 (args);
-         call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
-         UNGCPRO;
-       }
-
-      tail = Fcdr (tail);
-    }
-
-  if (NILP (doc))
-    tail = Fcons (lambda_list, tail);
-  else
-    tail = Fcons (lambda_list, Fcons (doc, tail));
-
-  defn = Fcons (Qlambda, tail);
-  if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization!  */
-    defn = Ffunction (Fcons (defn, Qnil));
-  defn = Fcons (Qmacro, defn);
-
-  if (!NILP (Vpurify_flag))
-    defn = Fpurecopy (defn);
-  if (CONSP (XSYMBOL (fn_name)->function)
-      && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
-    LOADHIST_ATTACH (Fcons (Qt, fn_name));
-  Ffset (fn_name, defn);
-  LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
-  return fn_name;
-}
-
-
 DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
        doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
 Aliased variables always have the same value; setting one sets the other.
@@ -2014,12 +1911,11 @@ this does nothing and returns nil.  */)
     /* Only add entries after dumping, because the ones before are
        not useful and else we get loads of them from the loaddefs.el.  */
     LOADHIST_ATTACH (Fcons (Qautoload, function));
-  else
-    /* We don't want the docstring in purespace (instead,
-       Snarf-documentation should (hopefully) overwrite it).
-       We used to use 0 here, but that leads to accidental sharing in
-       purecopy's hash-consing, so we use a (hopefully) unique integer
-       instead.  */
+  else if (EQ (docstring, make_number (0)))
+    /* `read1' in lread.c has found the docstring starting with "\
+       and assumed the docstring will be provided by Snarf-documentation, so it
+       passed us 0 instead.  But that leads to accidental sharing in purecopy's
+       hash-consing, so we use a (hopefully) unique integer instead.  */
     docstring = make_number (XUNTAG (function, Lisp_Symbol));
   return Ffset (function,
                Fpurecopy (list5 (Qautoload, file, docstring,
@@ -3576,7 +3472,6 @@ before making `inhibit-quit' nil.  */);
 
   DEFSYM (Qinteractive, "interactive");
   DEFSYM (Qcommandp, "commandp");
-  DEFSYM (Qdefun, "defun");
   DEFSYM (Qand_rest, "&rest");
   DEFSYM (Qand_optional, "&optional");
   DEFSYM (Qclosure, "closure");
@@ -3638,23 +3533,16 @@ Note that `debug-on-error', `debug-on-quit' and friends
 still determine whether to handle the particular condition.  */);
   Vdebug_on_signal = Qnil;
 
-  DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function,
-              doc: /* Function to process declarations in a macro definition.
-The function will be called with two args MACRO and DECL.
-MACRO is the name of the macro being defined.
-DECL is a list `(declare ...)' containing the declarations.
-The value the function returns is not used.  */);
-  Vmacro_declaration_function = Qnil;
-
   /* When lexical binding is being used,
-   vinternal_interpreter_environment is non-nil, and contains an alist
+   Vinternal_interpreter_environment is non-nil, and contains an alist
    of lexically-bound variable, or (t), indicating an empty
    environment.  The lisp name of this variable would be
    `internal-interpreter-environment' if it weren't hidden.
    Every element of this list can be either a cons (VAR . VAL)
    specifying a lexical binding, or a single symbol VAR indicating
    that this variable should use dynamic scoping.  */
-  DEFSYM (Qinternal_interpreter_environment, "internal-interpreter-environment");
+  DEFSYM (Qinternal_interpreter_environment,
+         "internal-interpreter-environment");
   DEFVAR_LISP ("internal-interpreter-environment",
                Vinternal_interpreter_environment,
               doc: /* If non-nil, the current lexical environment of the lisp interpreter.
@@ -3685,8 +3573,6 @@ alist of active lexical bindings.  */);
   defsubr (&Ssetq);
   defsubr (&Squote);
   defsubr (&Sfunction);
-  defsubr (&Sdefun);
-  defsubr (&Sdefmacro);
   defsubr (&Sdefvar);
   defsubr (&Sdefvaralias);
   defsubr (&Sdefconst);
index 50c21915af1ed1a5d694f70fe85f0d68cd4af3ca..544277db3b5f0760a7dbbc3d6e87b7a2cb0f56cd 100644 (file)
@@ -3001,7 +3001,7 @@ extern void init_lread (void);
 extern void syms_of_lread (void);
 
 /* Defined in eval.c.  */
-extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
+extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qmacro;
 extern Lisp_Object Qinhibit_quit, Qclosure;
 extern Lisp_Object Qand_rest;
 extern Lisp_Object Vautoload_queue;
index 7aba203d6855c35feda60fbc688f0010afa16ad2..38b00a66962abfd09f8f30d73c8687adfaf8be65 100644 (file)
@@ -2982,7 +2982,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
 
        /* If purifying, and string starts with \ newline,
           return zero instead.  This is for doc strings
-          that we are really going to find in etc/DOC.nn.nn  */
+          that we are really going to find in etc/DOC.nn.nn.  */
        if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
          return make_number (0);
 
@@ -3095,18 +3095,17 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
                                          nbytes)
               : nbytes);
 
-         if (uninterned_symbol && ! NILP (Vpurify_flag))
-           name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
-         else
-           name = make_specified_string (read_buffer, nchars, nbytes, multibyte);
+         name = ((uninterned_symbol && ! NILP (Vpurify_flag)
+                  ? make_pure_string : make_specified_string)
+                 (read_buffer, nchars, nbytes, multibyte));
          result = (uninterned_symbol ? Fmake_symbol (name)
                    : Fintern (name, Qnil));
 
          if (EQ (Vread_with_symbol_positions, Qt)
              || EQ (Vread_with_symbol_positions, readcharfun))
-           Vread_symbol_positions_list =
-             Fcons (Fcons (result, make_number (start_position)),
-                    Vread_symbol_positions_list);
+           Vread_symbol_positions_list
+             Fcons (Fcons (result, make_number (start_position)),
+                      Vread_symbol_positions_list);
          return result;
        }
       }
@@ -3520,7 +3519,7 @@ read_list (int flag, register Lisp_Object readcharfun)
               We don't use Fexpand_file_name because that would make
               the directory absolute now.  */
            elt = concat2 (build_string ("../lisp/"),
-                          Ffile_name_nondirectory (elt));
+                        Ffile_name_nondirectory (elt));
        }
       else if (EQ (elt, Vload_file_name)
               && ! NILP (elt)