mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +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

14
libguile/eval.i.c
View file

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

4
libguile/gsubr.c
View file

@ -179,16 +179,14 @@ scm_c_define_gsubr_with_generic (const char *name,
SCM SCM
scm_gsubr_apply (SCM args) scm_gsubr_apply (SCM self, SCM args)
#define FUNC_NAME "scm_gsubr_apply" #define FUNC_NAME "scm_gsubr_apply"
{ {
SCM self = SCM_CAR (args);
SCM (*fcn)() = SCM_SUBRF (self); SCM (*fcn)() = SCM_SUBRF (self);
SCM v[SCM_GSUBR_MAX]; SCM v[SCM_GSUBR_MAX];
unsigned int typ = SCM_GSUBR_TYPE (self); unsigned int typ = SCM_GSUBR_TYPE (self);
long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ); 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++) { for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
if (scm_is_null (args)) if (scm_is_null (args))
scm_wrong_num_args (SCM_SNAME (self)); 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, int req, int opt, int rst,
SCM (*fcn) (), SCM *gf); 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); SCM_INTERNAL void scm_init_gsubr (void);
#endif /* SCM_GSUBR_H */ #endif /* SCM_GSUBR_H */