From 30b7cf9df0f51bc2a3553396dc368c197eab4d8d Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 31 Oct 2013 12:52:23 +0100 Subject: [PATCH] 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. --- libguile/procprop.c | 5 ++--- libguile/procs.c | 12 ++---------- 2 files changed, 4 insertions(+), 13 deletions(-) diff --git a/libguile/procprop.c b/libguile/procprop.c index 78a40c1e2..9965b451a 100644 --- 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 8d9ef15b4..b02182427 100644 --- 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 -- 2.20.1