diff options
Diffstat (limited to 'libguile/procs.c')
-rw-r--r-- | libguile/procs.c | 27 |
1 files changed, 23 insertions, 4 deletions
diff --git a/libguile/procs.c b/libguile/procs.c index acd7e4663..74cb86cce 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -31,6 +31,9 @@ #include "libguile/validate.h" #include "libguile/procs.h" +#include "libguile/procprop.h" +#include "libguile/objcodes.h" +#include "libguile/programs.h" @@ -221,7 +224,9 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0, obj = SCM_PROCEDURE (obj); goto again; default: - ; + if (SCM_PROGRAM_P (obj) && SCM_PROGRAM_DATA (obj)->nargs == 0) + return SCM_BOOL_T; + /* otherwise fall through */ } } return SCM_BOOL_F; @@ -297,11 +302,25 @@ 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); - return scm_double_cell (scm_tc7_pws, - SCM_UNPACK (procedure), - SCM_UNPACK (setter), 0); + ret = scm_double_cell (scm_tc7_pws, + SCM_UNPACK (procedure), + SCM_UNPACK (setter), 0); + /* don't use procedure_name, because don't care enough to do a reverse + lookup */ + switch (SCM_TYP7 (procedure)) { + case scm_tcs_subrs: + name = SCM_SNAME (procedure); + break; + default: + name = scm_procedure_property (procedure, scm_sym_name); + break; + } + if (scm_is_true (name)) + scm_set_procedure_property_x (ret, scm_sym_name, name); + return ret; } #undef FUNC_NAME |