Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
Lisp_Object Qdeclare;
+Lisp_Object Qcurry;
+Lisp_Object Qinternal_interpreter_environment, Qclosure;
+
Lisp_Object Qdebug;
/* This holds either the symbol `run-hooks' or nil.
Lisp_Object Vautoload_queue;
+/* When lexical binding is being used, this is non-nil, and contains an
+ alist of lexically-bound variable, or (t), indicating an empty
+ environment. The lisp name of this variable is
+ `internal-interpreter-environment'. 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. */
+
+Lisp_Object Vinternal_interpreter_environment;
+
/* Current number of specbindings allocated in specpdl. */
EMACS_INT specpdl_size;
int handling_signal;
-static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object*);
+static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
+static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *);
static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
static int interactive_p (int);
-static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, int);
\f
void
init_eval_once (void)
specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
specpdl_ptr = specpdl;
/* Don't forget to update docs (lispref node "Local Variables"). */
- max_specpdl_size = 1000;
+ max_specpdl_size = 1200; /* 1000 is not enough for CEDET's c-by.el. */
max_lisp_eval_depth = 600;
Vrun_hooks = Qnil;
while (CONSP (args))
{
- val = Feval (XCAR (args));
+ val = eval_sub (XCAR (args));
if (!NILP (val))
break;
args = XCDR (args);
while (CONSP (args))
{
- val = Feval (XCAR (args));
+ val = eval_sub (XCAR (args));
if (NILP (val))
break;
args = XCDR (args);
struct gcpro gcpro1;
GCPRO1 (args);
- cond = Feval (Fcar (args));
+ cond = eval_sub (Fcar (args));
UNGCPRO;
if (!NILP (cond))
- return Feval (Fcar (Fcdr (args)));
+ return eval_sub (Fcar (Fcdr (args)));
return Fprogn (Fcdr (Fcdr (args)));
}
while (!NILP (args))
{
clause = Fcar (args);
- val = Feval (Fcar (clause));
+ val = eval_sub (Fcar (clause));
if (!NILP (val))
{
if (!EQ (XCDR (clause), Qnil))
while (CONSP (args))
{
- val = Feval (XCAR (args));
+ val = eval_sub (XCAR (args));
args = XCDR (args);
}
do
{
if (!(argnum++))
- val = Feval (Fcar (args_left));
+ val = eval_sub (Fcar (args_left));
else
- Feval (Fcar (args_left));
+ eval_sub (Fcar (args_left));
args_left = Fcdr (args_left);
}
while (!NILP(args_left));
do
{
if (!(argnum++))
- val = Feval (Fcar (args_left));
+ val = eval_sub (Fcar (args_left));
else
- Feval (Fcar (args_left));
+ eval_sub (Fcar (args_left));
args_left = Fcdr (args_left);
}
while (!NILP (args_left));
(Lisp_Object args)
{
register Lisp_Object args_left;
- register Lisp_Object val, sym;
+ register Lisp_Object val, sym, lex_binding;
struct gcpro gcpro1;
if (NILP (args))
do
{
- val = Feval (Fcar (Fcdr (args_left)));
+ val = eval_sub (Fcar (Fcdr (args_left)));
sym = Fcar (args_left);
- Fset (sym, val);
+
+ /* Like for eval_sub, we do not check declared_special here since
+ it's been done when let-binding. */
+ if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
+ && SYMBOLP (sym)
+ && !NILP (lex_binding
+ = Fassq (sym, Vinternal_interpreter_environment)))
+ XSETCDR (lex_binding, val); /* SYM is lexically bound. */
+ else
+ Fset (sym, val); /* SYM is dynamically bound. */
+
args_left = Fcdr (Fcdr (args_left));
}
while (!NILP(args_left));
usage: (function ARG) */)
(Lisp_Object args)
{
+ Lisp_Object quoted = XCAR (args);
+
if (!NILP (Fcdr (args)))
xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
- return Fcar (args);
+
+ if (!NILP (Vinternal_interpreter_environment)
+ && CONSP (quoted)
+ && EQ (XCAR (quoted), Qlambda))
+ /* This is a lambda expression within a lexical environment;
+ return an interpreted closure instead of a simple lambda. */
+ return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, quoted));
+ else
+ /* Simply quote the argument. */
+ return quoted;
}
use `called-interactively-p'. */)
(void)
{
- return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
+ return interactive_p (1) ? Qt : Qnil;
}
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)
tail = Fcons (lambda_list, tail);
else
tail = Fcons (lambda_list, Fcons (doc, tail));
- defn = Fcons (Qmacro, Fcons (Qlambda, 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);
error ("Don't know how to make a let-bound variable an alias");
}
+ sym->declared_special = 1;
sym->redirect = SYMBOL_VARALIAS;
SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
sym->constant = SYMBOL_CONSTANT_P (base_variable);
tem = Fdefault_boundp (sym);
if (!NILP (tail))
{
+ if (SYMBOLP (sym))
+ /* Do it before evaluating the initial value, for self-references. */
+ XSYMBOL (sym)->declared_special = 1;
+
if (SYMBOL_CONSTANT_P (sym))
{
/* For upward compatibility, allow (defvar :foo (quote :foo)). */
}
if (NILP (tem))
- Fset_default (sym, Feval (Fcar (tail)));
+ Fset_default (sym, eval_sub (Fcar (tail)));
else
{ /* Check if there is really a global binding rather than just a let
binding that shadows the global unboundness of the var. */
}
LOADHIST_ATTACH (sym);
}
+ else if (!NILP (Vinternal_interpreter_environment)
+ && !XSYMBOL (sym)->declared_special)
+ /* A simple (defvar foo) with lexical scoping does "nothing" except
+ declare that var to be dynamically scoped *locally* (i.e. within
+ the current file or let-block). */
+ Vinternal_interpreter_environment =
+ Fcons (sym, Vinternal_interpreter_environment);
else
/* Simple (defvar <var>) should not count as a definition at all.
It could get in the way of other definitions, and unloading this
package could try to make the variable unbound. */
;
-
+
return sym;
}
if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
error ("Too many arguments");
- tem = Feval (Fcar (Fcdr (args)));
+ tem = eval_sub (Fcar (Fcdr (args)));
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fset_default (sym, tem);
+ XSYMBOL (sym)->declared_special = 1;
tem = Fcar (Fcdr (Fcdr (args)));
if (!NILP (tem))
{
usage: (let* VARLIST BODY...) */)
(Lisp_Object args)
{
- Lisp_Object varlist, val, elt;
+ Lisp_Object varlist, var, val, elt, lexenv;
int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (args, elt, varlist);
+ lexenv = Vinternal_interpreter_environment;
+
varlist = Fcar (args);
- while (!NILP (varlist))
+ while (CONSP (varlist))
{
QUIT;
- elt = Fcar (varlist);
+
+ elt = XCAR (varlist);
if (SYMBOLP (elt))
- specbind (elt, Qnil);
+ {
+ var = elt;
+ val = Qnil;
+ }
else if (! NILP (Fcdr (Fcdr (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
else
{
- val = Feval (Fcar (Fcdr (elt)));
- specbind (Fcar (elt), val);
+ var = Fcar (elt);
+ val = eval_sub (Fcar (Fcdr (elt)));
}
- varlist = Fcdr (varlist);
+
+ if (!NILP (lexenv) && SYMBOLP (var)
+ && !XSYMBOL (var)->declared_special
+ && NILP (Fmemq (var, Vinternal_interpreter_environment)))
+ /* Lexically bind VAR by adding it to the interpreter's binding
+ alist. */
+ {
+ Lisp_Object newenv
+ = Fcons (Fcons (var, val), Vinternal_interpreter_environment);
+ if (EQ (Vinternal_interpreter_environment, lexenv))
+ /* Save the old lexical environment on the specpdl stack,
+ but only for the first lexical binding, since we'll never
+ need to revert to one of the intermediate ones. */
+ specbind (Qinternal_interpreter_environment, newenv);
+ else
+ Vinternal_interpreter_environment = newenv;
+ }
+ else
+ specbind (var, val);
+
+ varlist = XCDR (varlist);
}
+
UNGCPRO;
+
val = Fprogn (Fcdr (args));
+
return unbind_to (count, val);
}
usage: (let VARLIST BODY...) */)
(Lisp_Object args)
{
- Lisp_Object *temps, tem;
+ Lisp_Object *temps, tem, lexenv;
register Lisp_Object elt, varlist;
int count = SPECPDL_INDEX ();
register int argnum;
else if (! NILP (Fcdr (Fcdr (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
else
- temps [argnum++] = Feval (Fcar (Fcdr (elt)));
+ temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
gcpro2.nvars = argnum;
}
UNGCPRO;
+ lexenv = Vinternal_interpreter_environment;
+
varlist = Fcar (args);
for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
{
+ Lisp_Object var;
+
elt = XCAR (varlist);
+ var = SYMBOLP (elt) ? elt : Fcar (elt);
tem = temps[argnum++];
- if (SYMBOLP (elt))
- specbind (elt, tem);
+
+ if (!NILP (lexenv) && SYMBOLP (var)
+ && !XSYMBOL (var)->declared_special
+ && NILP (Fmemq (var, Vinternal_interpreter_environment)))
+ /* Lexically bind VAR by adding it to the lexenv alist. */
+ lexenv = Fcons (Fcons (var, tem), lexenv);
else
- specbind (Fcar (elt), tem);
+ /* Dynamically bind VAR. */
+ specbind (var, tem);
}
+ if (!EQ (lexenv, Vinternal_interpreter_environment))
+ /* Instantiate a new lexical environment. */
+ specbind (Qinternal_interpreter_environment, lexenv);
+
elt = Fprogn (Fcdr (args));
SAFE_FREE ();
return unbind_to (count, elt);
test = Fcar (args);
body = Fcdr (args);
- while (!NILP (Feval (test)))
+ while (!NILP (eval_sub (test)))
{
QUIT;
Fprogn (body);
struct gcpro gcpro1;
GCPRO1 (args);
- tag = Feval (Fcar (args));
+ tag = eval_sub (Fcar (args));
UNGCPRO;
return internal_catch (tag, Fprogn, Fcdr (args));
}
int count = SPECPDL_INDEX ();
record_unwind_protect (Fprogn, Fcdr (args));
- val = Feval (Fcar (args));
+ val = eval_sub (Fcar (args));
return unbind_to (count, val);
}
\f
h.tag = &c;
handlerlist = &h;
- val = Feval (bodyform);
+ val = eval_sub (bodyform);
catchlist = c.next;
handlerlist = h.next;
return val;
}
\f
-DEFUN ("eval", Feval, Seval, 1, 1, 0,
- doc: /* Evaluate FORM and return its value. */)
- (Lisp_Object form)
+DEFUN ("eval", Feval, Seval, 1, 2, 0,
+ doc: /* Evaluate FORM and return its value.
+If LEXICAL is t, evaluate using lexical scoping. */)
+ (Lisp_Object form, Lisp_Object lexical)
+{
+ int count = SPECPDL_INDEX ();
+ specbind (Qinternal_interpreter_environment,
+ NILP (lexical) ? Qnil : Fcons (Qt, Qnil));
+ return unbind_to (count, eval_sub (form));
+}
+
+/* Eval a sub-expression of the current expression (i.e. in the same
+ lexical scope). */
+Lisp_Object
+eval_sub (Lisp_Object form)
{
Lisp_Object fun, val, original_fun, original_args;
Lisp_Object funcar;
abort ();
if (SYMBOLP (form))
- return Fsymbol_value (form);
+ {
+ /* Look up its binding in the lexical environment.
+ We do not pay attention to the declared_special flag here, since we
+ already did that when let-binding the variable. */
+ Lisp_Object lex_binding
+ = !NILP (Vinternal_interpreter_environment) /* Mere optimization! */
+ ? Fassq (form, Vinternal_interpreter_environment)
+ : Qnil;
+ if (CONSP (lex_binding))
+ return XCDR (lex_binding);
+ else
+ return Fsymbol_value (form);
+ }
+
if (!CONSP (form))
return form;
while (!NILP (args_left))
{
- vals[argnum++] = Feval (Fcar (args_left));
+ vals[argnum++] = eval_sub (Fcar (args_left));
args_left = Fcdr (args_left);
gcpro3.nvars = argnum;
}
maxargs = XSUBR (fun)->max_args;
for (i = 0; i < maxargs; args_left = Fcdr (args_left))
{
- argvals[i] = Feval (Fcar (args_left));
+ argvals[i] = eval_sub (Fcar (args_left));
gcpro3.nvars = ++i;
}
}
}
}
- else if (COMPILEDP (fun))
- val = apply_lambda (fun, original_args, 1);
+ else if (FUNVECP (fun))
+ val = apply_lambda (fun, original_args);
else
{
if (EQ (fun, Qunbound))
goto retry;
}
if (EQ (funcar, Qmacro))
- val = Feval (apply1 (Fcdr (fun), original_args));
- else if (EQ (funcar, Qlambda))
- val = apply_lambda (fun, original_args, 1);
+ val = eval_sub (apply1 (Fcdr (fun), original_args));
+ else if (EQ (funcar, Qlambda)
+ || EQ (funcar, Qclosure))
+ val = apply_lambda (fun, original_args);
else
xsignal1 (Qinvalid_function, original_fun);
}
/* The caller should GCPRO all the elements of ARGS. */
+DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
+ doc: /* Return non-nil if OBJECT is a type of object that can be called as a function. */)
+ (Lisp_Object object)
+{
+ if (SYMBOLP (object) && !NILP (Ffboundp (object)))
+ {
+ object = Findirect_function (object, Qnil);
+
+ if (CONSP (object) && EQ (XCAR (object), Qautoload))
+ {
+ /* Autoloaded symbols are functions, except if they load
+ macros or keymaps. */
+ int i;
+ for (i = 0; i < 4 && CONSP (object); i++)
+ object = XCDR (object);
+
+ return (CONSP (object) && !NILP (XCAR (object))) ? Qnil : Qt;
+ }
+ }
+
+ if (SUBRP (object))
+ return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil;
+ else if (FUNVECP (object))
+ return Qt;
+ else if (CONSP (object))
+ {
+ Lisp_Object car = XCAR (object);
+ return (EQ (car, Qlambda) || EQ (car, Qclosure)) ? Qt : Qnil;
+ }
+ else
+ return Qnil;
+}
+
DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
doc: /* Call first argument as a function, passing remaining arguments to it.
Return the value that function returns.
}
}
}
- else if (COMPILEDP (fun))
+ else if (FUNVECP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
{
funcar = XCAR (fun);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, original_fun);
- if (EQ (funcar, Qlambda))
+ if (EQ (funcar, Qlambda)
+ || EQ (funcar, Qclosure))
val = funcall_lambda (fun, numargs, args + 1);
else if (EQ (funcar, Qautoload))
{
}
\f
static Lisp_Object
-apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
+apply_lambda (Lisp_Object fun, Lisp_Object args)
{
Lisp_Object args_left;
Lisp_Object numargs;
for (i = 0; i < XINT (numargs);)
{
tem = Fcar (args_left), args_left = Fcdr (args_left);
- if (eval_flag) tem = Feval (tem);
+ tem = eval_sub (tem);
arg_vector[i++] = tem;
gcpro1.nvars = i;
}
UNGCPRO;
- if (eval_flag)
- {
- backtrace_list->args = arg_vector;
- backtrace_list->nargs = i;
- }
+ backtrace_list->args = arg_vector;
+ backtrace_list->nargs = i;
backtrace_list->evalargs = 0;
tem = funcall_lambda (fun, XINT (numargs), arg_vector);
return tem;
}
+
+/* Call a non-bytecode funvec object FUN, on the argments in ARGS (of
+ length NARGS). */
+
+static Lisp_Object
+funcall_funvec (Lisp_Object fun, int nargs, Lisp_Object *args)
+{
+ int size = FUNVEC_SIZE (fun);
+ Lisp_Object tag = (size > 0 ? AREF (fun, 0) : Qnil);
+
+ if (EQ (tag, Qcurry))
+ {
+ /* A curried function is a way to attach arguments to a another
+ function. The first element of the vector is the identifier
+ `curry', the second is the wrapped function, and remaining
+ elements are the attached arguments. */
+ int num_curried_args = size - 2;
+ /* Offset of the curried and user args in the final arglist. Curried
+ args are first in the new arg vector, after the function. User
+ args follow. */
+ int curried_args_offs = 1;
+ int user_args_offs = curried_args_offs + num_curried_args;
+ /* The curried function and arguments. */
+ Lisp_Object *curry_params = XVECTOR (fun)->contents + 1;
+ /* The arguments in the curry vector. */
+ Lisp_Object *curried_args = curry_params + 1;
+ /* The number of arguments with which we'll call funcall, and the
+ arguments themselves. */
+ int num_funcall_args = 1 + num_curried_args + nargs;
+ Lisp_Object *funcall_args
+ = (Lisp_Object *) alloca (num_funcall_args * sizeof (Lisp_Object));
+
+ /* First comes the real function. */
+ funcall_args[0] = curry_params[0];
+
+ /* Then the arguments in the appropriate order. */
+ memcpy (funcall_args + curried_args_offs, curried_args,
+ num_curried_args * sizeof (Lisp_Object));
+ memcpy (funcall_args + user_args_offs, args,
+ nargs * sizeof (Lisp_Object));
+
+ return Ffuncall (num_funcall_args, funcall_args);
+ }
+ else
+ xsignal1 (Qinvalid_function, fun);
+}
+
+
/* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
and return the result of evaluation.
FUN must be either a lambda-expression or a compiled-code object. */
static Lisp_Object
-funcall_lambda (Lisp_Object fun, int nargs, register Lisp_Object *arg_vector)
+funcall_lambda (Lisp_Object fun, int nargs,
+ register Lisp_Object *arg_vector)
{
- Lisp_Object val, syms_left, next;
+ Lisp_Object val, syms_left, next, lexenv;
int count = SPECPDL_INDEX ();
int i, optional, rest;
+ if (COMPILEDP (fun)
+ && FUNVEC_SIZE (fun) > COMPILED_PUSH_ARGS
+ && ! NILP (XVECTOR (fun)->contents[COMPILED_PUSH_ARGS]))
+ /* A byte-code object with a non-nil `push args' slot means we
+ shouldn't bind any arguments, instead just call the byte-code
+ interpreter directly; it will push arguments as necessary.
+
+ Byte-code objects with either a non-existant, or a nil value for
+ the `push args' slot (the default), have dynamically-bound
+ arguments, and use the argument-binding code below instead (as do
+ all interpreted functions, even lexically bound ones). */
+ {
+ /* If we have not actually read the bytecode string
+ and constants vector yet, fetch them from the file. */
+ if (CONSP (AREF (fun, COMPILED_BYTECODE)))
+ Ffetch_bytecode (fun);
+ return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
+ AREF (fun, COMPILED_CONSTANTS),
+ AREF (fun, COMPILED_STACK_DEPTH),
+ AREF (fun, COMPILED_ARGLIST),
+ nargs, arg_vector);
+ }
+
+ if (FUNVECP (fun) && !FUNVEC_COMPILED_P (fun))
+ /* Byte-compiled functions are handled directly below, but we
+ call other funvec types via funcall_funvec. */
+ return funcall_funvec (fun, nargs, arg_vector);
+
if (CONSP (fun))
{
+ if (EQ (XCAR (fun), Qclosure))
+ {
+ fun = XCDR (fun); /* Drop `closure'. */
+ lexenv = XCAR (fun);
+ fun = XCDR (fun); /* Drop the lexical environment. */
+ }
+ else
+ lexenv = Qnil;
syms_left = XCDR (fun);
if (CONSP (syms_left))
syms_left = XCAR (syms_left);
xsignal1 (Qinvalid_function, fun);
}
else if (COMPILEDP (fun))
- syms_left = AREF (fun, COMPILED_ARGLIST);
+ {
+ syms_left = AREF (fun, COMPILED_ARGLIST);
+ lexenv = Qnil;
+ }
else
abort ();
rest = 1;
else if (EQ (next, Qand_optional))
optional = 1;
- else if (rest)
+ else
{
- specbind (next, Flist (nargs - i, &arg_vector[i]));
- i = nargs;
+ Lisp_Object val;
+ if (rest)
+ {
+ val = Flist (nargs - i, &arg_vector[i]);
+ i = nargs;
+ }
+ else if (i < nargs)
+ val = arg_vector[i++];
+ else if (!optional)
+ xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
+ else
+ val = Qnil;
+
+ /* Bind the argument. */
+ if (!NILP (lexenv) && SYMBOLP (next)
+ /* FIXME: there's no good reason to allow dynamic-scoping
+ on function arguments, other than consistency with let. */
+ && !XSYMBOL (next)->declared_special
+ && NILP (Fmemq (next, Vinternal_interpreter_environment)))
+ /* Lexically bind NEXT by adding it to the lexenv alist. */
+ lexenv = Fcons (Fcons (next, val), lexenv);
+ else
+ /* Dynamically bind NEXT. */
+ specbind (next, val);
}
- else if (i < nargs)
- specbind (next, arg_vector[i++]);
- else if (!optional)
- xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
- else
- specbind (next, Qnil);
}
if (!NILP (syms_left))
else if (i < nargs)
xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
+ if (!EQ (lexenv, Vinternal_interpreter_environment))
+ /* Instantiate a new lexical environment. */
+ specbind (Qinternal_interpreter_environment, lexenv);
+
if (CONSP (fun))
val = Fprogn (XCDR (XCDR (fun)));
else
and constants vector yet, fetch them from the file. */
if (CONSP (AREF (fun, COMPILED_BYTECODE)))
Ffetch_bytecode (fun);
- val = Fbyte_code (AREF (fun, COMPILED_BYTECODE),
- AREF (fun, COMPILED_CONSTANTS),
- AREF (fun, COMPILED_STACK_DEPTH));
+ val = exec_byte_code (AREF (fun, COMPILED_BYTECODE),
+ AREF (fun, COMPILED_CONSTANTS),
+ AREF (fun, COMPILED_STACK_DEPTH),
+ Qnil, 0, 0);
}
return unbind_to (count, val);
UNGCPRO;
return value;
}
+
+\f
+
+DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0,
+ doc: /* Return non-nil if SYMBOL's global binding has been declared special.
+A special variable is one that will be bound dynamically, even in a
+context where binding is lexical by default. */)
+ (Lisp_Object symbol)
+{
+ CHECK_SYMBOL (symbol);
+ return XSYMBOL (symbol)->declared_special ? Qt : Qnil;
+}
+
\f
+
+DEFUN ("curry", Fcurry, Scurry, 1, MANY, 0,
+ doc: /* Return FUN curried with ARGS.
+The result is a function-like object that will append any arguments it
+is called with to ARGS, and call FUN with the resulting list of arguments.
+
+For instance:
+ (funcall (curry '+ 3 4 5) 2) is the same as (funcall '+ 3 4 5 2)
+and:
+ (mapcar (curry 'concat "The ") '("a" "b" "c"))
+ => ("The a" "The b" "The c")
+
+usage: (curry FUN &rest ARGS) */)
+ (int nargs, Lisp_Object *args)
+{
+ return make_funvec (Qcurry, 0, nargs, args);
+}
+\f
+
DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
The debugger is entered when that frame exits, if the flag is non-nil. */)
Qand_optional = intern_c_string ("&optional");
staticpro (&Qand_optional);
+ Qclosure = intern_c_string ("closure");
+ staticpro (&Qclosure);
+
+ Qcurry = intern_c_string ("curry");
+ staticpro (&Qcurry);
+
Qdebug = intern_c_string ("debug");
staticpro (&Qdebug);
The value the function returns is not used. */);
Vmacro_declaration_function = Qnil;
+ Qinternal_interpreter_environment
+ = intern_c_string ("internal-interpreter-environment");
+ staticpro (&Qinternal_interpreter_environment);
+#if 0 /* Don't export this variable to Elisp, so noone can mess with it
+ (Just imagine if someone makes it buffer-local). */
+ DEFVAR_LISP ("internal-interpreter-environment",
+ &Vinternal_interpreter_environment,
+ doc: /* If non-nil, the current lexical environment of the lisp interpreter.
+When lexical binding is not being used, this variable is nil.
+A value of `(t)' indicates an empty environment, otherwise it is an
+alist of active lexical bindings. */);
+#endif
+ Vinternal_interpreter_environment = Qnil;
+
Vrun_hooks = intern_c_string ("run-hooks");
staticpro (&Vrun_hooks);
defsubr (&Srun_hook_with_args_until_success);
defsubr (&Srun_hook_with_args_until_failure);
defsubr (&Sfetch_bytecode);
+ defsubr (&Scurry);
defsubr (&Sbacktrace_debug);
defsubr (&Sbacktrace);
defsubr (&Sbacktrace_frame);
+ defsubr (&Scurry);
+ defsubr (&Sspecial_variable_p);
+ defsubr (&Sfunctionp);
}