mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 06:20:23 +02:00
* procprop.c (scm_i_procedure_arity): Bugfix: Handle generics.
This commit is contained in:
parent
f4250a95f9
commit
815ce8d58a
1 changed files with 11 additions and 22 deletions
|
@ -120,29 +120,18 @@ scm_i_procedure_arity (SCM proc)
|
|||
r = 1;
|
||||
break;
|
||||
case scm_tcs_cons_gloc:
|
||||
if (!SCM_I_OPERATORP (proc))
|
||||
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
|
||||
{
|
||||
r = 1;
|
||||
break;
|
||||
}
|
||||
else if (!SCM_I_OPERATORP (proc))
|
||||
return SCM_BOOL_F;
|
||||
{
|
||||
SCM *p = (SCM_I_ENTITYP (proc)
|
||||
? &SCM_ENTITY_PROC_0 (proc)
|
||||
: &SCM_OPERATOR_PROC_0 (proc));
|
||||
SCM arity;
|
||||
int i, amin = -1, amax = 0;
|
||||
for (i = 0; i < 4; ++i)
|
||||
if (SCM_NFALSEP (arity = scm_i_procedure_arity (p[i])))
|
||||
{
|
||||
if (amin < 0)
|
||||
amin = i;
|
||||
amax = i;
|
||||
}
|
||||
if (amin < 0)
|
||||
/* no procedures in the struct! */
|
||||
return SCM_BOOL_F;
|
||||
a += amin;
|
||||
o = amax - amin;
|
||||
r = SCM_NFALSEP (arity) && SCM_NFALSEP (SCM_CADDR (arity));
|
||||
break;
|
||||
}
|
||||
proc = (SCM_I_ENTITYP (proc)
|
||||
? SCM_ENTITY_PROCEDURE (proc)
|
||||
: SCM_OPERATOR_PROCEDURE (proc));
|
||||
a -= 1;
|
||||
goto loop;
|
||||
default:
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue