mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

* debug.c, debug.h (scm_reverse_lookup): Added.

Browse source 
(scm_procedure_name): Use scm_reverse_lookup to lookup the name of
internal procedure definitions; Don't use scm_i_inner_name.

* debug.c (scm_procedure_source): Cons SCM_IM_LAMBDA onto
procedure source before calling scm_unmemocopy instead of faking
an environment.
This commit is contained in:
Mikael Djurfeldt 1999-07-29 21:11:37 +00:00
parent 6203706f4a
commit c75512d6a7
1 changed files with 28 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

30
libguile/debug.c
View file

@ -436,8 +436,8 @@ scm_procedure_name (proc)
if (SCM_FALSEP (name)) if (SCM_FALSEP (name))
name = scm_procedure_property (proc, scm_i_name); name = scm_procedure_property (proc, scm_i_name);
#endif #endif
if (SCM_FALSEP (name)) if (SCM_FALSEP (name) && SCM_CLOSUREP (proc))
name = scm_procedure_property (proc, scm_i_inner_name); name = scm_reverse_lookup (SCM_ENV (proc), proc);
return name; return name;
} }
} }
@ -523,6 +523,32 @@ scm_local_eval (exp, env)
return scm_eval_3 (exp, 1, env); return scm_eval_3 (exp, 1, env);
} }
#if 0
SCM_PROC (s_reverse_lookup, "reverse-lookup", 2, 0, 0, scm_reverse_lookup);
#endif
SCM
scm_reverse_lookup (SCM env, SCM data)
{
SCM names, values;
while (SCM_NIMP (env) && SCM_CONSP (SCM_CAR (env)))
{
names = SCM_CAAR (env);
values = SCM_CDAR (env);
while (SCM_NIMP (names) && SCM_CONSP (names))
{
if (SCM_CAR (values) == data)
return SCM_CAR (names);
names = SCM_CDR (names);
values = SCM_CDR (values);
}
if (names != SCM_EOL && values == data)
return names;
env = SCM_CDR (env);
}
return SCM_BOOL_F;
}
SCM SCM
scm_start_stack (id, exp, env) scm_start_stack (id, exp, env)
SCM id; SCM id;