Reduce code duplication in parts of (auto)load&defalias

* src/data.c (defalias): New function, extracted from `Fdefalias`.
(Fdefalias): Use it.
(Ffset): Don't handle `Vautoload_queue` here, handle it in
`defalias` instead.
* src/comp.c (comp--register-subr): Use `defalias` instead of
duplicating its code.

* src/eval.c (load_with_autoload_queue): New function, extracted from
`Fautoload_do_load`.
(Fautoload_do_load): Use it.
(un_autoload): Mark it as static.
* src/fns.c (Frequire): Use it as well.

* src/lisp.h (defalias, load_with_autoload_queue): New declarations.
(un_autoload): Remove declaration.
This commit is contained in:
Stefan Monnier 2022-01-28 13:19:11 -05:00
parent 1f5fa1de7f
commit 7531bf096e
7 changed files with 66 additions and 64 deletions

View file

@ -1,6 +1,6 @@
;;; cl-preloaded.el --- Preloaded part of the CL library -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc
;; Copyright (C) 2015-2022 Free Software Foundation, Inc
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Package: emacs

View file

@ -5500,19 +5500,7 @@ This gets called by top_level_run during the load phase. */)
make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, type, doc_idx,
intspec, comp_u);
if (AUTOLOADP (XSYMBOL (name)->u.s.function))
/* Remember that the function was already an autoload. */
LOADHIST_ATTACH (Fcons (Qt, name));
LOADHIST_ATTACH (Fcons (Qdefun, name));
{ /* Handle automatic advice activation (bug#42038).
See `defalias'. */
Lisp_Object hook = Fget (name, Qdefalias_fset_function);
if (!NILP (hook))
call2 (hook, name, tem);
else
Ffset (name, tem);
}
defalias (name, tem);
return tem;
}

View file

@ -846,9 +846,6 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
function = XSYMBOL (symbol)->u.s.function;
if (!NILP (Vautoload_queue) && !NILP (function))
Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
if (AUTOLOADP (function))
Fput (symbol, Qautoload, XCDR (function));
@ -866,6 +863,35 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
return definition;
}
void
defalias (Lisp_Object symbol, Lisp_Object definition)
{
{
bool autoload = AUTOLOADP (definition);
if (!will_dump_p () || !autoload)
{ /* Only add autoload entries after dumping, because the ones before are
not useful and else we get loads of them from the loaddefs.el. */
Lisp_Object function = XSYMBOL (symbol)->u.s.function;
if (AUTOLOADP (function))
/* Remember that the function was already an autoload. */
LOADHIST_ATTACH (Fcons (Qt, symbol));
LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
if (!NILP (Vautoload_queue) && !NILP (function))
Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
}
}
{ /* Handle automatic advice activation. */
Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
if (!NILP (hook))
call2 (hook, symbol, definition);
else
Ffset (symbol, definition);
}
}
DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
doc: /* Set SYMBOL's function definition to DEFINITION.
Associates the function with the current load file, if any.
@ -885,26 +911,7 @@ The return value is undefined. */)
&& !KEYMAPP (definition))
definition = Fpurecopy (definition);
{
bool autoload = AUTOLOADP (definition);
if (!will_dump_p () || !autoload)
{ /* Only add autoload entries after dumping, because the ones before are
not useful and else we get loads of them from the loaddefs.el. */
if (AUTOLOADP (XSYMBOL (symbol)->u.s.function))
/* Remember that the function was already an autoload. */
LOADHIST_ATTACH (Fcons (Qt, symbol));
LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
}
}
{ /* Handle automatic advice activation. */
Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
if (!NILP (hook))
call2 (hook, symbol, definition);
else
Ffset (symbol, definition);
}
defalias (symbol, definition);
maybe_defer_native_compilation (symbol, definition);

View file

@ -2247,7 +2247,7 @@ this does nothing and returns nil. */)
Qnil);
}
void
static void
un_autoload (Lisp_Object oldqueue)
{
Lisp_Object queue, first, second;
@ -2269,6 +2269,32 @@ un_autoload (Lisp_Object oldqueue)
}
}
Lisp_Object
load_with_autoload_queue
(Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
Lisp_Object nosuffix, Lisp_Object must_suffix)
{
ptrdiff_t count = SPECPDL_INDEX ();
/* If autoloading gets an error (which includes the error of failing
to define the function being called), we use Vautoload_queue
to undo function definitions and `provide' calls made by
the function. We do this in the specific case of autoloading
because autoloading is not an explicit request "load this file",
but rather a request to "call this function".
The value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
Lisp_Object tem
= save_match_data_load (file, noerror, nomessage, nosuffix, must_suffix);
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
unbind_to (count, Qnil);
return tem;
}
/* Load an autoloaded function.
FUNNAME is the symbol which is the function's name.
FUNDEF is the autoload definition (a list). */
@ -2281,8 +2307,6 @@ If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
it defines a macro. */)
(Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
{
ptrdiff_t count = SPECPDL_INDEX ();
if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
return fundef;
@ -2299,26 +2323,12 @@ it defines a macro. */)
CHECK_SYMBOL (funname);
/* If autoloading gets an error (which includes the error of failing
to define the function being called), we use Vautoload_queue
to undo function definitions and `provide' calls made by
the function. We do this in the specific case of autoloading
because autoloading is not an explicit request "load this file",
but rather a request to "call this function".
The value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
/* If `macro_only' is set and fundef isn't a macro, assume this autoload to
be a "best-effort" (e.g. to try and find a compiler macro),
so don't signal an error if autoloading fails. */
Lisp_Object ignore_errors
= (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only;
save_match_data_load (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt);
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
unbind_to (count, Qnil);
load_with_autoload_queue (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt);
if (NILP (funname) || !NILP (ignore_errors))
return Qnil;

View file

@ -3249,12 +3249,8 @@ FILENAME are suppressed. */)
record_unwind_protect (require_unwind, require_nesting_list);
require_nesting_list = Fcons (feature, require_nesting_list);
/* Value saved here is to be restored into Vautoload_queue */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
/* Load the file. */
tem = save_match_data_load
tem = load_with_autoload_queue
(NILP (filename) ? Fsymbol_name (feature) : filename,
noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil));
@ -3276,8 +3272,6 @@ FILENAME are suppressed. */)
SDATA (tem3), tem2);
}
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
feature = unbind_to (count, feature);
}

View file

@ -620,6 +620,7 @@ extern bool symbols_with_pos_enabled;
extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object);
extern Lisp_Object default_value (Lisp_Object symbol);
extern void defalias (Lisp_Object symbol, Lisp_Object definition);
/* Defined in emacs.c. */
@ -4366,7 +4367,9 @@ extern AVOID verror (const char *, va_list)
ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern Lisp_Object vformat_string (const char *, va_list)
ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern void un_autoload (Lisp_Object);
extern Lisp_Object load_with_autoload_queue
(Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
Lisp_Object nosuffix, Lisp_Object must_suffix);
extern Lisp_Object call_debugger (Lisp_Object arg);
extern void init_eval_once (void);
extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);

View file

@ -1,6 +1,6 @@
;;; range-tests.el --- Tests for range.el -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.