diff options
Diffstat (limited to 'libguile/procs.c')
-rw-r--r-- | libguile/procs.c | 24 |
1 files changed, 7 insertions, 17 deletions
diff --git a/libguile/procs.c b/libguile/procs.c index a096591df..7a2f491d9 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -46,21 +46,10 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0, "Return @code{#t} if @var{obj} is a procedure.") #define FUNC_NAME s_scm_procedure_p { - if (SCM_NIMP (obj)) - switch (SCM_TYP7 (obj)) - { - case scm_tcs_struct: - if (!((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_PURE_GENERIC) - || SCM_STRUCT_APPLICABLE_P (obj))) - break; - case scm_tc7_program: - return SCM_BOOL_T; - case scm_tc7_smob: - return scm_from_bool (SCM_SMOB_DESCRIPTOR (obj).apply); - default: - return SCM_BOOL_F; - } - return SCM_BOOL_F; + return scm_from_bool (SCM_PROGRAM_P (obj) + || (SCM_STRUCTP (obj) && SCM_STRUCT_APPLICABLE_P (obj)) + || (SCM_HAS_TYP7 (obj, scm_tc7_smob) + && SCM_SMOB_APPLICABLE_P (obj))); } #undef FUNC_NAME @@ -146,14 +135,15 @@ SCM_PRIMITIVE_GENERIC (scm_setter, "setter", 1, 0, 0, "applicable struct with a setter.") #define FUNC_NAME s_scm_setter { - SCM_GASSERT1 (SCM_STRUCTP (proc), g_scm_setter, proc, SCM_ARG1, FUNC_NAME); + if (SCM_UNLIKELY (!SCM_STRUCTP (proc))) + return scm_wta_dispatch_1 (g_scm_setter, proc, SCM_ARG1, FUNC_NAME); if (SCM_STRUCT_SETTER_P (proc)) return SCM_STRUCT_SETTER (proc); if (SCM_PUREGENERICP (proc) && SCM_IS_A_P (proc, scm_class_generic_with_setter)) /* FIXME: might not be an accessor */ return SCM_GENERIC_SETTER (proc); - SCM_WTA_DISPATCH_1 (g_scm_setter, proc, SCM_ARG1, FUNC_NAME); + return scm_wta_dispatch_1 (g_scm_setter, proc, SCM_ARG1, FUNC_NAME); return SCM_BOOL_F; /* not reached */ } #undef FUNC_NAME |