mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

Avoid calling procedure-name when doing a make-procedure-with-setter

Browse source 
* libguile/procs.c (scm_make_procedure_with_setter): Don't set the name
  of the procedure.  Instead rely on procedure-name to look it up from
  the wrapped procedure as needed.
* libguile/procprop.c (scm_procedure_name): If there was no override and
  the procedure is a procedure-with-setter, recurse on the procedure.
This commit is contained in:
Andy Wingo 2013-10-31 12:52:23 +01:00
parent 6165d8120d
commit 30b7cf9df0
2 changed files with 4 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/procprop.c
View file

@ -249,9 +249,6 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
SCM_VALIDATE_PROC (1, proc); SCM_VALIDATE_PROC (1, proc);
while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
proc = SCM_STRUCT_PROCEDURE (proc);
user_props = scm_weak_table_refq (overrides, proc, SCM_BOOL_F); user_props = scm_weak_table_refq (overrides, proc, SCM_BOOL_F);
if (scm_is_true (user_props)) if (scm_is_true (user_props))
{ {
@ -266,6 +263,8 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
return scm_i_rtl_program_name (proc); return scm_i_rtl_program_name (proc);
else if (SCM_PROGRAM_P (proc)) else if (SCM_PROGRAM_P (proc))
return scm_assq_ref (scm_i_program_properties (proc), scm_sym_name); return scm_assq_ref (scm_i_program_properties (proc), scm_sym_name);
else if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
return scm_procedure_name (SCM_STRUCT_PROCEDURE (proc));
else else
return SCM_BOOL_F; return SCM_BOOL_F;
} }

12
libguile/procs.c
View file

@ -89,18 +89,10 @@ SCM_DEFINE (scm_make_procedure_with_setter, "make-procedure-with-setter", 2, 0,
"with the associated setter @var{setter}.") "with the associated setter @var{setter}.")
#define FUNC_NAME s_scm_make_procedure_with_setter #define FUNC_NAME s_scm_make_procedure_with_setter
{ {
SCM name, ret;
SCM_VALIDATE_PROC (1, procedure); SCM_VALIDATE_PROC (1, procedure);
SCM_VALIDATE_PROC (2, setter); SCM_VALIDATE_PROC (2, setter);
ret = scm_make_struct (pws_vtable, SCM_INUM0, return scm_make_struct (pws_vtable, SCM_INUM0,
scm_list_2 (procedure, setter)); scm_list_2 (procedure, setter));
/* don't use procedure_name, because don't care enough to do a reverse
lookup */
name = scm_procedure_property (procedure, scm_sym_name);
if (scm_is_true (name))
scm_set_procedure_property_x (ret, scm_sym_name, name);
return ret;
} }
#undef FUNC_NAME #undef FUNC_NAME