(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.
+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)
#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
#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
for (tmp = filename; *tmp; tmp++)
{
- if (IS_DIRECTORY_SEP(*tmp))
+ if (IS_DIRECTORY_SEP (*tmp))
filename = tmp + 1;
}
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);
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);
commas = 3;
else if (defvarflag)
commas = 1;
- else /* For DEFSIMPLE and DEFPRED */
+ else /* For DEFSIMPLE and DEFPRED. */
commas = 2;
while (commas)
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
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
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
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)
{
if (infile == NULL)
{
perror (filename);
- return 0; /* No error */
+ return 0; /* No error. */
}
c = '\n';
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 */
|| ! 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);
}
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);
}
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"))
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
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);
+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.
(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.
(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)
;; 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.
(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)
(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)
;; 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))
;; 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)))))
(`(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")
'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)))
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\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)
(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))
(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)
(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))
(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 " ")
(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
(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))
(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)
(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)
(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)
\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
(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)
;; 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
. ,(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
(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))
(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))
;; 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)
(,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)
(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
;; 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)
+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).
* 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.
#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_*. */
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;
}
\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. */)
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))
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");
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;
}
-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.
/* 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,
DEFSYM (Qinteractive, "interactive");
DEFSYM (Qcommandp, "commandp");
- DEFSYM (Qdefun, "defun");
DEFSYM (Qand_rest, "&rest");
DEFSYM (Qand_optional, "&optional");
DEFSYM (Qclosure, "closure");
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.
defsubr (&Ssetq);
defsubr (&Squote);
defsubr (&Sfunction);
- defsubr (&Sdefun);
- defsubr (&Sdefmacro);
defsubr (&Sdefvar);
defsubr (&Sdefvaralias);
defsubr (&Sdefconst);
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;
/* 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);
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;
}
}
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)
projects / emacs.git / commitdiff