mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 14:00:21 +02:00
* tags.h (SCM_IM_CALL_WITH_VALUES): New isym.
* eval.c: Include "libguile/values.h" (scm_m_at_call_with_values, scm_sym_at_call_with_values): New. (unmemocopy, scm_ceval, scm_deval): Handle new isym. * eval.h (scm_sym_at_call_with_values, scm_m_at_call_with_values): New delcarations to support above change. * eval.c (scm_primitive_eval_x, scm_primitive_eval): Fix syntax errors with last change. * eval.c (scm_primitive_eval_x, scm_primitive_eval, scm_i_eval_x, scm_i_eval): Moved the application of the system transformer from scm_i_eval to scm_primitive_eval.
This commit is contained in:
parent
baeda60023
commit
a513ead308
1 changed files with 51 additions and 16 deletions
|
@ -100,6 +100,7 @@ char *alloca ();
|
|||
#include "libguile/root.h"
|
||||
#include "libguile/vectors.h"
|
||||
#include "libguile/fluids.h"
|
||||
#include "libguile/values.h"
|
||||
|
||||
#include "libguile/validate.h"
|
||||
#include "libguile/eval.h"
|
||||
|
@ -1129,6 +1130,17 @@ scm_m_atbind (SCM xorig, SCM env)
|
|||
return scm_cons (SCM_IM_BIND, SCM_CDR (xorig));
|
||||
}
|
||||
|
||||
SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_makmmacro, scm_m_at_call_with_values);
|
||||
SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values);
|
||||
|
||||
SCM
|
||||
scm_m_at_call_with_values (SCM xorig, SCM env)
|
||||
{
|
||||
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2,
|
||||
scm_s_expression, s_at_call_with_values);
|
||||
return scm_cons (SCM_IM_CALL_WITH_VALUES, SCM_CDR (xorig));
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_m_expand_body (SCM xorig, SCM env)
|
||||
{
|
||||
|
@ -1416,6 +1428,9 @@ unmemocopy (SCM x, SCM env)
|
|||
ls = z = scm_cons (scm_sym_delay, SCM_UNSPECIFIED);
|
||||
x = SCM_CDR (x);
|
||||
goto loop;
|
||||
case (SCM_ISYMNUM (SCM_IM_CALL_WITH_VALUES)):
|
||||
ls = z = scm_cons (scm_sym_at_call_with_values, SCM_UNSPECIFIED);
|
||||
goto loop;
|
||||
default:
|
||||
/* appease the Sun compiler god: */ ;
|
||||
}
|
||||
|
@ -2198,6 +2213,10 @@ dispatch:
|
|||
PREP_APPLY (proc, SCM_EOL);
|
||||
t.arg1 = SCM_CDR (SCM_CDR (x));
|
||||
t.arg1 = EVALCAR (t.arg1, env);
|
||||
apply_closure:
|
||||
/* Go here to tail-call a closure. PROC is the closure
|
||||
and T.ARG1 is the list of arguments. Do not forget to
|
||||
call PREP_APPLY. */
|
||||
#ifdef DEVAL
|
||||
debug.info->a.args = t.arg1;
|
||||
#endif
|
||||
|
@ -2453,8 +2472,27 @@ dispatch:
|
|||
arg2 = SCM_CDR (arg2);
|
||||
}
|
||||
|
||||
RETURN (proc)
|
||||
RETURN (proc);
|
||||
|
||||
case (SCM_ISYMNUM (SCM_IM_CALL_WITH_VALUES)):
|
||||
{
|
||||
proc = SCM_CDR (x);
|
||||
x = EVALCAR (proc, env);
|
||||
proc = SCM_CDR (proc);
|
||||
proc = EVALCAR (proc, env);
|
||||
t.arg1 = SCM_APPLY (x, SCM_EOL, SCM_EOL);
|
||||
if (SCM_VALUESP (t.arg1))
|
||||
t.arg1 = scm_struct_ref (t.arg1, SCM_INUM0);
|
||||
else
|
||||
t.arg1 = scm_cons (t.arg1, SCM_EOL);
|
||||
if (SCM_CLOSUREP (proc))
|
||||
{
|
||||
PREP_APPLY (proc, t.arg1);
|
||||
goto apply_closure;
|
||||
}
|
||||
return SCM_APPLY (proc, t.arg1, SCM_EOL);
|
||||
}
|
||||
|
||||
default:
|
||||
goto badfun;
|
||||
}
|
||||
|
@ -3846,7 +3884,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
|
|||
evaluates EXP in environment ENV. ENV is a lexical environment
|
||||
structure as used by the actual tree code evaluator. When ENV is
|
||||
a top-level environment, then changes to the current module are
|
||||
tracked by modifying ENV so that it continues to be in sync with
|
||||
tracked by updating ENV so that it continues to be in sync with
|
||||
the current module.
|
||||
|
||||
- scm_primitive_eval (exp)
|
||||
|
@ -3858,7 +3896,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
|
|||
|
||||
- scm_eval (exp, mod)
|
||||
|
||||
evaluates EXP while MOD is the current module. Thius is done by
|
||||
evaluates EXP while MOD is the current module. This is done by
|
||||
setting the current module to MOD, invoking scm_primitive_eval on
|
||||
EXP, and then restoring the current module to the value it had
|
||||
previously. That is, while EXP is evaluated, changes to the
|
||||
|
@ -3876,33 +3914,26 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
|
|||
|
||||
SCM scm_system_transformer;
|
||||
|
||||
/* XXX - scm_i_eval is meant to be useable for evaluation in
|
||||
non-toplevel environments, for example when used by the debugger.
|
||||
Can the system transform deal with this? */
|
||||
|
||||
SCM
|
||||
scm_i_eval_x (SCM exp, SCM env)
|
||||
{
|
||||
SCM transformer = scm_fluid_ref (SCM_CDR (scm_system_transformer));
|
||||
if (SCM_NIMP (transformer))
|
||||
exp = scm_apply (transformer, exp, scm_listofnull);
|
||||
return SCM_XEVAL (exp, env);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_i_eval (SCM exp, SCM env)
|
||||
{
|
||||
SCM transformer = scm_fluid_ref (SCM_CDR (scm_system_transformer));
|
||||
if (SCM_NIMP (transformer))
|
||||
exp = scm_apply (transformer, exp, scm_listofnull);
|
||||
exp = scm_copy_tree (exp);
|
||||
return SCM_XEVAL (exp, env);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_primitive_eval_x (SCM exp)
|
||||
{
|
||||
SCM env = scm_top_level_env (scm_current_module_lookup_closure ());
|
||||
SCM env;
|
||||
SCM transformer = scm_fluid_ref (SCM_CDR (scm_system_transformer));
|
||||
if (SCM_NIMP (transformer))
|
||||
exp = scm_apply (transformer, exp, scm_listofnull);
|
||||
env = scm_top_level_env (scm_current_module_lookup_closure ());
|
||||
return scm_i_eval_x (exp, env);
|
||||
}
|
||||
|
||||
|
@ -3912,7 +3943,11 @@ SCM_DEFINE (scm_primitive_eval, "primitive-eval", 1, 0, 0,
|
|||
"the current module.")
|
||||
#define FUNC_NAME s_scm_primitive_eval
|
||||
{
|
||||
SCM env = scm_top_level_env (scm_current_module_lookup_closure ());
|
||||
SCM env;
|
||||
SCM transformer = scm_fluid_ref (SCM_CDR (scm_system_transformer));
|
||||
if (SCM_NIMP (transformer))
|
||||
exp = scm_apply (transformer, exp, scm_listofnull);
|
||||
env = scm_top_level_env (scm_current_module_lookup_closure ());
|
||||
return scm_i_eval (exp, env);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue