From 61b108cc62d69c96c20b9e23b248185591563c1f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 29 May 2012 23:59:42 -0400 Subject: [PATCH] * lisp/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. * 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. --- lib-src/ChangeLog | 48 ++-- lib-src/make-docfile.c | 153 ++++------- lisp/ChangeLog | 32 ++- lisp/emacs-lisp/byte-opt.el | 2 +- lisp/emacs-lisp/byte-run.el | 111 ++++++-- lisp/emacs-lisp/bytecomp.el | 492 ++++++++++++++++------------------- lisp/emacs-lisp/cconv.el | 25 -- lisp/emacs-lisp/elint.el | 2 + lisp/emacs-lisp/lisp-mode.el | 2 - lisp/emacs-lisp/macroexp.el | 16 +- lisp/loadup.el | 15 ++ src/ChangeLog | 28 +- src/data.c | 10 +- src/eval.c | 132 +--------- src/lisp.h | 2 +- src/lread.c | 17 +- 16 files changed, 491 insertions(+), 596 deletions(-) diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 7dc02ccaa95..d95137852e0 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,9 @@ +2012-05-30 Stefan Monnier + + * make-docfile.c: Improve comment style. + (search_lisp_doc_at_eol): New function. + (scan_lisp_file): Use it. + 2012-05-26 Glenn Morris * Makefile.in (INSTALL_DATA): Remove; unused. @@ -441,8 +447,8 @@ * 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 @@ -2819,7 +2825,7 @@ * make-docfile.c (read_c_string_or_comment): Declare msgno. - * Makefile.in (YACC): Deleted. + * Makefile.in (YACC): Delete. 2002-10-19 Andreas Schwab @@ -3037,7 +3043,7 @@ (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ì @@ -3078,7 +3084,7 @@ (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 @@ -3339,7 +3345,7 @@ (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. @@ -3776,7 +3782,7 @@ 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. @@ -4252,7 +4258,7 @@ (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. @@ -4775,7 +4781,7 @@ 1997-05-13 Francesco Potortì * etags.c (TeX_functions): Cleaned up. - (tex_getit): Removed. + (tex_getit): Remove. 1997-05-13 Paul Eggert @@ -5296,7 +5302,7 @@ * 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. @@ -5797,7 +5803,7 @@ 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. @@ -5816,9 +5822,9 @@ (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. @@ -6394,7 +6400,7 @@ 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. @@ -6511,9 +6517,9 @@ 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 @@ -6832,7 +6838,7 @@ * 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 @@ -7131,10 +7137,10 @@ * 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. @@ -7142,7 +7148,7 @@ 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) diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index b33b13f34ce..1314a7b6829 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -35,7 +35,7 @@ along with GNU Emacs. If not, see . */ #include -/* 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 . */ #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); diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 80cbdef406c..ccd4de5f754 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,8 +1,32 @@ +2012-05-30 Stefan Monnier + + * 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 * 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 - * 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. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 9dd475f2a51..7cb93890cb5 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -500,7 +500,7 @@ (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) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 7de3396f8ed..9b04e9889dd 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -34,33 +34,98 @@ ;; 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))))) ;; Redefined in byte-optimize.el. ;; This is not documented--it's not clear that we should promote it. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2518d8359c3..ce4d5d64ae2 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -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)))))) @@ -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." ;;; 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) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 3ce0eadab55..f43dd9e7ee4 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -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)) diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index 5b82cd477f9..82e958533e8 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -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)) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 973d57d4210..2a4cd704a43 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -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) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 21c351159c2..ba8f9c4c148 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -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 diff --git a/lisp/loadup.el b/lisp/loadup.el index c5180e9ff6c..fae742f6638 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -318,6 +318,21 @@ ;; 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) diff --git a/src/ChangeLog b/src/ChangeLog index e39ec206bf8..0c050535d8e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2012-05-30 Stefan Monnier + + * 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 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 @@ -103,12 +113,12 @@ 2012-05-26 Eli Zaretskii 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. @@ -646,7 +656,7 @@ (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. @@ -1091,8 +1101,8 @@ * 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. diff --git a/src/data.c b/src/data.c index 11660a2483d..defcd06a2ed 100644 --- a/src/data.c +++ b/src/data.c @@ -34,6 +34,7 @@ along with GNU Emacs. If not, see . */ #include "syssignal.h" #include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */ #include "font.h" +#include "keymap.h" #include /* 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) } -/* 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"); diff --git a/src/eval.c b/src/eval.c index e44b7e32915..1da841a4073 100644 --- a/src/eval.c +++ b/src/eval.c @@ -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); diff --git a/src/lisp.h b/src/lisp.h index 50c21915af1..544277db3b5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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; diff --git a/src/lread.c b/src/lread.c index 7aba203d685..38b00a66962 100644 --- a/src/lread.c +++ b/src/lread.c @@ -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) -- 2.39.2