mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 14:50:19 +02:00
Code Activity

* procprop.c (scm_i_procedure_arity): Bugfix: Handle generics.

Browse source
This commit is contained in:
Mikael Djurfeldt 1999-08-29 03:27:18 +00:00
parent f4250a95f9
commit 815ce8d58a
1 changed files with 11 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

33
libguile/procprop.c
View file

@ -120,29 +120,18 @@ scm_i_procedure_arity (SCM proc)
r = 1; r = 1;
break; break;
case scm_tcs_cons_gloc: 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; return SCM_BOOL_F;
{ proc = (SCM_I_ENTITYP (proc)
SCM *p = (SCM_I_ENTITYP (proc) ? SCM_ENTITY_PROCEDURE (proc)
? &SCM_ENTITY_PROC_0 (proc) : SCM_OPERATOR_PROCEDURE (proc));
: &SCM_OPERATOR_PROC_0 (proc)); a -= 1;
SCM arity; goto loop;
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;
}
default: default:
return SCM_BOOL_F; return SCM_BOOL_F;
} }