-DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
- doc: /* Bind variables according to VARLIST then eval BODY.
-The value of the last form in BODY is returned.
-Each element of VARLIST is a symbol (which is bound to nil)
-or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
-Each VALUEFORM can refer to the symbols already bound by this VARLIST.
-usage: (let* VARLIST BODY...) */)
- (Lisp_Object args)
-{
- Lisp_Object varlist, var, val, elt, lexenv;
- dynwind_begin ();
- struct gcpro gcpro1, gcpro2, gcpro3;
-
- GCPRO3 (args, elt, varlist);
-
- lexenv = Vinternal_interpreter_environment;
-
- varlist = XCAR (args);
- while (CONSP (varlist))
- {
- QUIT;
-
- elt = XCAR (varlist);
- if (SYMBOLP (elt))
- {
- var = elt;
- val = Qnil;
- }
- else if (! NILP (Fcdr (Fcdr (elt))))
- signal_error ("`let' bindings can have only one value-form", elt);
- else
- {
- var = Fcar (elt);
- val = eval_sub (Fcar (Fcdr (elt)));
- }
-
- 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 (XCDR (args));
- dynwind_end ();
- return val;
-}
-
-DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0,
- doc: /* Bind variables according to VARLIST then eval BODY.
-The value of the last form in BODY is returned.
-Each element of VARLIST is a symbol (which is bound to nil)
-or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
-All the VALUEFORMs are evalled before any symbols are bound.
-usage: (let VARLIST BODY...) */)
- (Lisp_Object args)
-{
- Lisp_Object *temps, tem, lexenv;
- register Lisp_Object elt, varlist;
- dynwind_begin ();
- ptrdiff_t argnum;
- struct gcpro gcpro1, gcpro2;
- USE_SAFE_ALLOCA;
-
- varlist = XCAR (args);
-
- /* Make space to hold the values to give the bound variables. */
- elt = Flength (varlist);
- SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
-
- /* Compute the values and store them in `temps'. */
-
- GCPRO2 (args, *temps);
- gcpro2.nvars = 0;
-
- for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
- {
- QUIT;
- elt = XCAR (varlist);
- if (SYMBOLP (elt))
- temps [argnum++] = Qnil;
- else if (! NILP (Fcdr (Fcdr (elt))))
- signal_error ("`let' bindings can have only one value-form", elt);
- else
- temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
- gcpro2.nvars = argnum;
- }
- UNGCPRO;
-
- lexenv = Vinternal_interpreter_environment;
-
- varlist = XCAR (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 (!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
- /* Dynamically bind VAR. */
- specbind (var, tem);
- }
-
- if (!EQ (lexenv, Vinternal_interpreter_environment))
- /* Instantiate a new lexical environment. */
- specbind (Qinternal_interpreter_environment, lexenv);
-
- elt = Fprogn (XCDR (args));
- SAFE_FREE ();
- dynwind_end ();
- return elt;
-}
-
-DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
- doc: /* If TEST yields non-nil, eval BODY... and repeat.
-The order of execution is thus TEST, BODY, TEST, BODY and so on
-until TEST returns nil.
-usage: (while TEST BODY...) */)
- (Lisp_Object args)
-{
- Lisp_Object test, body;
- struct gcpro gcpro1, gcpro2;
-
- GCPRO2 (test, body);
-
- test = XCAR (args);
- body = XCDR (args);
- while (!NILP (eval_sub (test)))
- {
- QUIT;
- Fprogn (body);
- }
-
- UNGCPRO;
- return Qnil;
-}
-