mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-04 22:40:25 +02:00
Code Activity

simplify apply_foreign

Browse source 
* libguile/vm.c (apply_foreign): Simplify.
This commit is contained in:
Andy Wingo 2009-12-03 15:55:54 +01:00
parent d389e9661a
commit a941cde9e5
1 changed files with 8 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

34
libguile/vm.c
View file

@ -265,27 +265,8 @@ resolve_variable (SCM what, SCM program_module)
static SCM static SCM
apply_foreign (SCM proc, SCM *args, int nargs, int headroom) apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
{ {
SCM arg1, arg2, arg3;
SCM_ASRTGO (SCM_NIMP (proc), badproc); SCM_ASRTGO (SCM_NIMP (proc), badproc);
/* Parse args. */
switch (nargs)
{
case 0:
arg1 = SCM_UNDEFINED; arg2 = SCM_UNDEFINED; arg3 = SCM_UNDEFINED;
break;
case 1:
arg1 = args[0]; arg2 = SCM_UNDEFINED; arg3 = SCM_UNDEFINED;
break;
case 2:
arg1 = args[0]; arg2 = args[1]; arg3 = SCM_UNDEFINED;
break;
default:
arg1 = args[0]; arg2 = args[1]; arg3 = args[2];
break;
}
switch (SCM_TYP7 (proc)) switch (SCM_TYP7 (proc))
{ {
case scm_tcs_closures: case scm_tcs_closures:
@ -298,15 +279,16 @@ apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
} }
case scm_tc7_cxr: case scm_tc7_cxr:
if (nargs != 1) scm_wrong_num_args (proc); if (nargs != 1) scm_wrong_num_args (proc);
return scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc)); return scm_i_chase_pairs (args[0], (scm_t_bits) SCM_SUBRF (proc));
case scm_tc7_asubr: case scm_tc7_asubr:
if (nargs < 2) if (nargs < 2)
return SCM_SUBRF (proc) (arg1, SCM_UNDEFINED); return SCM_SUBRF (proc) (args[0], SCM_UNDEFINED);
{ {
SCM x = args[0];
int idx = 1; int idx = 1;
while (nargs-- > 1) while (nargs-- > 1)
arg1 = SCM_SUBRF (proc) (arg1, args[idx++]); x = SCM_SUBRF (proc) (x, args[idx++]);
return arg1; return x;
} }
case scm_tc7_rpsubr: case scm_tc7_rpsubr:
{ {
@ -326,15 +308,15 @@ apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
case 0: case 0:
return SCM_SMOB_APPLY_0 (proc); return SCM_SMOB_APPLY_0 (proc);
case 1: case 1:
return SCM_SMOB_APPLY_1 (proc, arg1); return SCM_SMOB_APPLY_1 (proc, args[0]);
case 2: case 2:
return SCM_SMOB_APPLY_2 (proc, arg1, arg2); return SCM_SMOB_APPLY_2 (proc, args[0], args[1]);
default: default:
{ {
SCM arglist = SCM_EOL; SCM arglist = SCM_EOL;
while (nargs-- > 2) while (nargs-- > 2)
arglist = scm_cons (args[nargs], arglist); arglist = scm_cons (args[nargs], arglist);
return SCM_SMOB_APPLY_3 (proc, arg1, arg2, arglist); return SCM_SMOB_APPLY_3 (proc, args[0], args[1], arglist);
} }
} }
case scm_tc7_gsubr: case scm_tc7_gsubr: