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

* 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.

diff --git a/libguile/procprop.c b/libguile/procprop.c
index 78a40c1..9965b45 100644 (file)
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -249,9 +249,6 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
 
   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);
   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);
   else if (SCM_PROGRAM_P (proc))
     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
     return SCM_BOOL_F;
 }

diff --git a/libguile/procs.c b/libguile/procs.c
index 8d9ef15..b021824 100644 (file)
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -89,18 +89,10 @@ SCM_DEFINE (scm_make_procedure_with_setter, "make-procedure-with-setter", 2, 0,
            "with the associated setter @var{setter}.")
 #define FUNC_NAME s_scm_make_procedure_with_setter
 {
-  SCM name, ret;
   SCM_VALIDATE_PROC (1, procedure);
   SCM_VALIDATE_PROC (2, setter);
-  ret = scm_make_struct (pws_vtable, SCM_INUM0,
-                         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;
+  return scm_make_struct (pws_vtable, SCM_INUM0,
+                          scm_list_2 (procedure, setter));
 }
 #undef FUNC_NAME