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

slight scm_procedure_p, scm_i_procedure_arity refactor

Browse source 
* libguile/procs.c (scm_procedure_p):
* libguile/procprop.c (scm_i_procedure_arity): Refactor.
This commit is contained in:
Andy Wingo 2011-10-24 18:29:45 +02:00
parent cf4c26625b
commit 8b33752be7
2 changed files with 13 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

21
libguile/procprop.c
View file

@ -48,23 +48,20 @@ scm_i_procedure_arity (SCM proc, int *req, int *opt, int *rest)
{ {
while (!SCM_PROGRAM_P (proc)) while (!SCM_PROGRAM_P (proc))
{ {
if (SCM_IMP (proc)) if (SCM_STRUCTP (proc))
return 0;
switch (SCM_TYP7 (proc))
{ {
case scm_tc7_smob:
if (!SCM_SMOB_APPLICABLE_P (proc))
return 0;
proc = scm_i_smob_apply_trampoline (proc);
break;
case scm_tcs_struct:
if (!SCM_STRUCT_APPLICABLE_P (proc)) if (!SCM_STRUCT_APPLICABLE_P (proc))
return 0; return 0;
proc = SCM_STRUCT_PROCEDURE (proc); proc = SCM_STRUCT_PROCEDURE (proc);
break;
default:
return 0;
} }
else if (SCM_HAS_TYP7 (proc, scm_tc7_smob))
{
if (!SCM_SMOB_APPLICABLE_P (proc))
return 0;
proc = scm_i_smob_apply_trampoline (proc);
}
else
return 0;
} }
return scm_i_program_arity (proc, req, opt, rest); return scm_i_program_arity (proc, req, opt, rest);
} }

19
libguile/procs.c
View file

@ -46,21 +46,10 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
"Return @code{#t} if @var{obj} is a procedure.") "Return @code{#t} if @var{obj} is a procedure.")
#define FUNC_NAME s_scm_procedure_p #define FUNC_NAME s_scm_procedure_p
{ {
if (SCM_NIMP (obj)) return scm_from_bool (SCM_PROGRAM_P (obj)
switch (SCM_TYP7 (obj)) || (SCM_STRUCTP (obj) && SCM_STRUCT_APPLICABLE_P (obj))
{ || (SCM_HAS_TYP7 (obj, scm_tc7_smob)
case scm_tcs_struct: && SCM_SMOB_APPLICABLE_P (obj)));
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;
} }
#undef FUNC_NAME #undef FUNC_NAME