mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

* eval.c (scm_sym_system_module): New symbol.

Browse source 
* eval.c, eval.h (scm_top_level_lookup_closure): New function:
Extract the lookup closure from an environment.
(scm_system_module_env_p): New function: Return non-#f if MODULE
is a system module.
* eval.c, procs.c, procs.h, procprop.c: Renamed getter ->
procedure throughout.
This commit is contained in:
Mikael Djurfeldt 1999-03-12 08:16:26 +00:00
parent a726dd9da5
commit 6bcb086819
1 changed files with 33 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

42
libguile/eval.c
View file

@ -3367,10 +3367,32 @@ SCM
scm_top_level_env (thunk)
SCM thunk;
{
if (SCM_IMP(thunk))
if (SCM_IMP (thunk))
return SCM_EOL;
else
return scm_cons(thunk, (SCM)SCM_EOL);
return scm_cons (thunk, SCM_EOL);
}
SCM
scm_top_level_lookup_closure (SCM env)
{
if (SCM_IMP (env))
return SCM_BOOL_F;
else
return SCM_CAR (scm_last_pair (env));
}
SCM_SYMBOL (scm_sym_system_module, "system-module");
SCM
scm_system_module_env_p (SCM env)
{
SCM proc = scm_top_level_lookup_closure (env);
return ((SCM_NFALSEP (proc)
&& SCM_NFALSEP (scm_procedure_property (proc,
scm_sym_system_module)))
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_eval2, "eval2", 2, 0, 0, scm_eval2);
@ -3380,7 +3402,7 @@ scm_eval2 (obj, env_thunk)
SCM obj;
SCM env_thunk;
{
return scm_eval_3 (obj, 1, scm_top_level_env(env_thunk));
return scm_eval_3 (obj, 1, scm_top_level_env (env_thunk));
}
SCM_PROC(s_eval, "eval", 1, 0, 0, scm_eval);
@ -3389,8 +3411,10 @@ SCM
scm_eval (obj)
SCM obj;
{
return
scm_eval_3(obj, 1, scm_top_level_env(SCM_CDR(scm_top_level_lookup_closure_var)));
return scm_eval_3 (obj,
1,
scm_top_level_env
(SCM_CDR (scm_top_level_lookup_closure_var)));
}
/* SCM_PROC(s_eval_x, "eval!", 1, 0, 0, scm_eval_x); */
@ -3399,10 +3423,10 @@ SCM
scm_eval_x (obj)
SCM obj;
{
return
scm_eval_3(obj,
0,
scm_top_level_env (SCM_CDR (scm_top_level_lookup_closure_var)));
return scm_eval_3 (obj,
0,
scm_top_level_env
(SCM_CDR (scm_top_level_lookup_closure_var)));
}
static const scm_smobfuns promsmob = {scm_markcdr, scm_free0, prinprom};