mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-28 19:00:42 -08:00
Code Issues Projects Releases Wiki Activity

Fix pcase memoizing; change lexbound byte-code marker.

Browse source 
* src/bytecode.c (exec_byte_code): Remove old lexical binding slot handling
and replace it with the a integer args-desc handling.
* eval.c (funcall_lambda): Adjust arglist test accordingly.
* lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-signature):
Handle integer arglist descriptor.
(byte-compile-make-args-desc): Make integer arglist descriptor.
(byte-compile-lambda): Use integer arglist descriptor to mark lexical
byte-coded functions instead of an extra slot.
* lisp/help-fns.el (help-add-fundoc-usage): Don't add a dummy doc.
(help-split-fundoc): Return a nil doc if there was no actual doc.
(help-function-arglist): Generate an arglist from an integer arg-desc.
* lisp/emacs-lisp/pcase.el (pcase--memoize): Rename from pcase-memoize;
Make only the key weak.
(pcase): Change the key used in the memoization table, so it does not
always get GC'd away.
* lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Slight change to the
pcase pattern to generate slightly better code.
This commit is contained in:
Stefan Monnier 2011-03-05 23:48:17 -05:00
parent d032d5e7df
commit e2abe5a13d
10 changed files with 188 additions and 78 deletions
Download patch file Download diff file Expand all files Collapse all files

71
src/bytecode.c
View file

@ -502,37 +502,50 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
stacke = stack.bottom - 1 + XFASTINT (maxdepth);
#endif
if (! NILP (args_template))
if (INTEGERP (args_template))
{
int at = XINT (args_template);
int rest = at & 128;
int mandatory = at & 127;
int nonrest = at >> 8;
eassert (mandatory <= nonrest);
if (nargs <= nonrest)
{
int i;
for (i = 0 ; i < nargs; i++, args++)
PUSH (*args);
if (nargs < mandatory)
/* Too few arguments. */
Fsignal (Qwrong_number_of_arguments,
Fcons (Fcons (make_number (mandatory),
rest ? Qand_rest : make_number (nonrest)),
Fcons (make_number (nargs), Qnil)));
else
{
for (; i < nonrest; i++)
PUSH (Qnil);
if (rest)
PUSH (Qnil);
}
}
else if (rest)
{
int i;
for (i = 0 ; i < nonrest; i++, args++)
PUSH (*args);
PUSH (Flist (nargs - nonrest, args));
}
else
/* Too many arguments. */
Fsignal (Qwrong_number_of_arguments,
Fcons (Fcons (make_number (mandatory),
make_number (nonrest)),
Fcons (make_number (nargs), Qnil)));
}
else if (! NILP (args_template))
/* We should push some arguments on the stack. */
{
Lisp_Object at;
int pushed = 0, optional = 0;
for (at = args_template; CONSP (at); at = XCDR (at))
if (EQ (XCAR (at), Qand_optional))
optional = 1;
else if (EQ (XCAR (at), Qand_rest))
{
PUSH (pushed < nargs
? Flist (nargs - pushed, args)
: Qnil);
pushed = nargs;
at = Qnil;
break;
}
else if (pushed < nargs)
{
PUSH (*args++);
pushed++;
}
else if (optional)
PUSH (Qnil);
else
break;
if (pushed != nargs || !NILP (at))
Fsignal (Qwrong_number_of_arguments,
Fcons (args_template, Fcons (make_number (nargs), Qnil)));
error ("Unknown args template!");
}
while (1)