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

Change `scm_gsubr_apply ()' to take the gsubr as its first argument.

Browse source 
* libguile/gsubr.c (scm_gsubr_apply): Make SELF the first argument
  instead of the first element of ARGS.

* libguile/gsubr.h: Update.

* libguile/eval.i.c (CEVAL): Update.
This commit is contained in:
Ludovic Courtès 2009-02-16 01:00:49 +01:00
parent e20d7001c3
commit 54d14084e2
3 changed files with 10 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

16
libguile/eval.i.c
View file

@ -1129,7 +1129,7 @@ dispatch:
debug.info->a.proc = proc;
debug.info->a.args = SCM_EOL;
#endif
RETURN (scm_gsubr_apply (scm_list_1 (proc)));
RETURN (scm_gsubr_apply (proc, SCM_EOL));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
#ifdef DEVAL
@ -1248,7 +1248,7 @@ dispatch:
debug.info->a.args = scm_cons (arg1, debug.info->a.args);
debug.info->a.proc = proc;
#endif
RETURN (scm_gsubr_apply (scm_list_2 (proc, arg1)));
RETURN (scm_gsubr_apply (proc, scm_list_1 (arg1)));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
#ifdef DEVAL
@ -1348,12 +1348,12 @@ dispatch:
cclon:
case scm_tc7_gsubr:
#ifdef DEVAL
RETURN (scm_gsubr_apply (scm_cons (proc, debug.info->a.args)));
RETURN (scm_gsubr_apply (proc, debug.info->a.args));
#else
RETURN (scm_gsubr_apply
(scm_cons (proc,
scm_cons2 (arg1, arg2,
scm_ceval_args (x, env, proc)))));
RETURN (scm_gsubr_apply (proc,
scm_cons2 (arg1, arg2,
scm_ceval_args (x, env,
proc))));
#endif
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
@ -1865,7 +1865,7 @@ tail:
#else
args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args));
#endif
RETURN (scm_gsubr_apply (scm_cons (proc, args)));
RETURN (scm_gsubr_apply (proc, args));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
#ifdef DEVAL

4
libguile/gsubr.c
View file

@ -179,16 +179,14 @@ scm_c_define_gsubr_with_generic (const char *name,
SCM
scm_gsubr_apply (SCM args)
scm_gsubr_apply (SCM self, SCM args)
#define FUNC_NAME "scm_gsubr_apply"
{
SCM self = SCM_CAR (args);
SCM (*fcn)() = SCM_SUBRF (self);
SCM v[SCM_GSUBR_MAX];
unsigned int typ = SCM_GSUBR_TYPE (self);
long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
args = SCM_CDR (args);
for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
if (scm_is_null (args))
scm_wrong_num_args (SCM_SNAME (self));

2
libguile/gsubr.h
View file

@ -48,7 +48,7 @@ SCM_API SCM scm_c_define_gsubr_with_generic (const char *name,
int req, int opt, int rst,
SCM (*fcn) (), SCM *gf);
SCM_API SCM scm_gsubr_apply (SCM args);
SCM_API SCM scm_gsubr_apply (SCM proc, SCM args);
SCM_INTERNAL void scm_init_gsubr (void);
#endif /* SCM_GSUBR_H */