mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-28 16:00:22 +02:00
Improved smob calls.
This commit is contained in:
Keisuke Nishida
parent
85270b4033
commit
cb1c46c57e
4 changed files with 303 additions and 164 deletions
|
|
@ -1,3 +1,25 @@
|
|||
2000-12-06 Keisuke Nishida <kxn30@po.cwru.edu>
|
||||
|
||||
* smob.h (scm_smob_descriptor): New fields `apply_0', `apply_1',
|
||||
`apply_2', and `apply_3'.
|
||||
* smob.c (scm_make_smob_type): Init new fields.
|
||||
(SCM_SMOB_APPLY0, SCM_SMOB_APPLY1, SCM_SMOB_APPLY2, SCM_SMOB_APPLY3):
|
||||
New macros.
|
||||
(scm_smob_apply_0_000, scm_smob_apply_0_010, scm_smob_apply_0_020,
|
||||
scm_smob_apply_0_030, scm_smob_apply_0_001, scm_smob_apply_0_011,
|
||||
scm_smob_apply_0_021, scm_smob_apply_0_error,
|
||||
scm_smob_apply_1_010, scm_smob_apply_1_020, scm_smob_apply_1_030,
|
||||
scm_smob_apply_1_001, scm_smob_apply_1_011, scm_smob_apply_1_021,
|
||||
scm_smob_apply_1_error,
|
||||
scm_smob_apply_2_020, scm_smob_apply_2_030, scm_smob_apply_2_001,
|
||||
scm_smob_apply_2_011, scm_smob_apply_2_021, scm_smob_apply_2_error,
|
||||
scm_smob_apply_3_030, scm_smob_apply_3_001, scm_smob_apply_3_011,
|
||||
scm_smob_apply_3_021, scm_smob_apply_3_error): New functions.
|
||||
(scm_set_smob_apply): Set new fields to the above functions.
|
||||
(scm_smob_apply_0, scm_smob_apply_1, scm_smob_apply_2,
|
||||
scm_smob_apply_3): Removed.
|
||||
* eval.c (SCM_CEVAL, SCM_APPLY): Rewrote smob calls.
|
||||
|
||||
2000-12-06 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* gc.c (scm_init_gc): gc_async must be protected from gc. I
|
||||
|
|
|
|||
|
|
@ -2580,7 +2580,7 @@ evapply:
|
|||
case scm_tc7_smob:
|
||||
if (!SCM_SMOB_DESCRIPTOR (proc).apply)
|
||||
goto badfun;
|
||||
RETURN (scm_smob_apply_0 (proc));
|
||||
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_0 (proc));
|
||||
case scm_tc7_cclo:
|
||||
t.arg1 = proc;
|
||||
proc = SCM_CCLO_SUBR (proc);
|
||||
|
|
@ -2729,7 +2729,7 @@ evapply:
|
|||
case scm_tc7_smob:
|
||||
if (!SCM_SMOB_DESCRIPTOR (proc).apply)
|
||||
goto badfun;
|
||||
RETURN (scm_smob_apply_1 (proc, t.arg1));
|
||||
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_1 (proc, t.arg1));
|
||||
case scm_tc7_cclo:
|
||||
arg2 = t.arg1;
|
||||
t.arg1 = proc;
|
||||
|
|
@ -2845,7 +2845,7 @@ evapply:
|
|||
case scm_tc7_smob:
|
||||
if (!SCM_SMOB_DESCRIPTOR (proc).apply)
|
||||
goto badfun;
|
||||
RETURN (scm_smob_apply_2 (proc, t.arg1, arg2));
|
||||
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_2 (proc, t.arg1, arg2));
|
||||
cclon:
|
||||
case scm_tc7_cclo:
|
||||
#ifdef DEVAL
|
||||
|
|
@ -2984,8 +2984,8 @@ evapply:
|
|||
case scm_tc7_smob:
|
||||
if (!SCM_SMOB_DESCRIPTOR (proc).apply)
|
||||
goto badfun;
|
||||
RETURN (scm_smob_apply_3 (proc, t.arg1, arg2,
|
||||
SCM_CDDR (debug.info->a.args)));
|
||||
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_3
|
||||
(proc, t.arg1, arg2, SCM_CDDR (debug.info->a.args)));
|
||||
case scm_tc7_cclo:
|
||||
goto cclon;
|
||||
case scm_tc7_pws:
|
||||
|
|
@ -3046,8 +3046,8 @@ evapply:
|
|||
case scm_tc7_smob:
|
||||
if (!SCM_SMOB_DESCRIPTOR (proc).apply)
|
||||
goto badfun;
|
||||
RETURN (scm_smob_apply_3 (proc, t.arg1, arg2,
|
||||
scm_eval_args (x, env, proc)));
|
||||
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_3
|
||||
(proc, t.arg1, arg2, scm_eval_args (x, env, proc)));
|
||||
case scm_tc7_cclo:
|
||||
goto cclon;
|
||||
case scm_tc7_pws:
|
||||
|
|
@ -3412,13 +3412,15 @@ tail:
|
|||
if (!SCM_SMOB_DESCRIPTOR (proc).apply)
|
||||
goto badproc;
|
||||
if (SCM_UNBNDP (arg1))
|
||||
RETURN (scm_smob_apply_0 (proc))
|
||||
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_0 (proc))
|
||||
else if (SCM_NULLP (args))
|
||||
RETURN (scm_smob_apply_1 (proc, arg1))
|
||||
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_1 (proc, arg1))
|
||||
else if (SCM_NULLP (SCM_CDR (args)))
|
||||
RETURN (scm_smob_apply_2 (proc, arg1, SCM_CAR (args)))
|
||||
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_2
|
||||
(proc, arg1, SCM_CAR (args)))
|
||||
else
|
||||
RETURN (scm_smob_apply_3 (proc, arg1, SCM_CAR (args), SCM_CDR (args)));
|
||||
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_3
|
||||
(proc, arg1, SCM_CAR (args), SCM_CDR (args)));
|
||||
case scm_tc7_cclo:
|
||||
#ifdef DEVAL
|
||||
args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args);
|
||||
|
|
|
|||
415
libguile/smob.c
415
libguile/smob.c
|
|
@ -125,169 +125,174 @@ scm_smob_print (SCM exp, SCM port, scm_print_state *pstate)
|
|||
/* {Apply}
|
||||
*/
|
||||
|
||||
/*
|
||||
* A possible future optimization:
|
||||
*
|
||||
* Let's call each of the forms of call below a "trampoline".
|
||||
*
|
||||
* We could make a function out of each trampoline and store four
|
||||
* pointers to trampolines in the descriptor, one corresponding to
|
||||
* each arity of call (apply_0, apply_1 etc.)
|
||||
*
|
||||
* Which trampoline to store in which field is chosen in scm_set_smob_apply.
|
||||
*/
|
||||
#define SCM_SMOB_APPLY0(SMOB) \
|
||||
SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB)
|
||||
#define SCM_SMOB_APPLY1(SMOB,A1) \
|
||||
SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1)
|
||||
#define SCM_SMOB_APPLY2(SMOB,A1,A2) \
|
||||
SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1, A2)
|
||||
#define SCM_SMOB_APPLY3(SMOB,A1,A2,A3) \
|
||||
SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1, A2, A3)
|
||||
|
||||
SCM
|
||||
scm_smob_apply_0 (SCM smob)
|
||||
static SCM
|
||||
scm_smob_apply_0_000 (SCM smob)
|
||||
{
|
||||
int type = SCM_SMOB_DESCRIPTOR (smob).gsubr_type;
|
||||
switch (type)
|
||||
{
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 0):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply ();
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 0):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, SCM_UNDEFINED);
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, SCM_EOL);
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 0):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob,
|
||||
SCM_UNDEFINED,
|
||||
SCM_UNDEFINED);
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob,
|
||||
SCM_UNDEFINED,
|
||||
SCM_EOL);
|
||||
case SCM_GSUBR_MAKTYPE (0, 3, 0):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob,
|
||||
SCM_UNDEFINED,
|
||||
SCM_UNDEFINED,
|
||||
SCM_UNDEFINED);
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob,
|
||||
SCM_UNDEFINED,
|
||||
SCM_UNDEFINED,
|
||||
SCM_EOL);
|
||||
default:
|
||||
if (SCM_GSUBR_REQ (type) > 0)
|
||||
scm_wrong_num_args (smob);
|
||||
scm_misc_error ("scm_smob_apply_0",
|
||||
"Unsupported smob application: ~S",
|
||||
SCM_LIST1 (smob));
|
||||
}
|
||||
return SCM_SMOB_APPLY0 (smob);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_smob_apply_1 (SCM smob, SCM a1)
|
||||
static SCM
|
||||
scm_smob_apply_0_010 (SCM smob)
|
||||
{
|
||||
int type = SCM_SMOB_DESCRIPTOR (smob).gsubr_type;
|
||||
switch (type)
|
||||
{
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 0):
|
||||
scm_wrong_num_args (smob);
|
||||
case SCM_GSUBR_MAKTYPE (1, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 0):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1);
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, SCM_LIST1 (a1));
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 0):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1, SCM_UNDEFINED);
|
||||
case SCM_GSUBR_MAKTYPE (1, 0, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1, SCM_EOL);
|
||||
case SCM_GSUBR_MAKTYPE (1, 2, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 3, 0):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1,
|
||||
SCM_UNDEFINED,
|
||||
SCM_UNDEFINED);
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1,
|
||||
SCM_UNDEFINED,
|
||||
SCM_EOL);
|
||||
default:
|
||||
if (SCM_GSUBR_REQ (type) > 1)
|
||||
scm_wrong_num_args (smob);
|
||||
scm_misc_error ("scm_smob_apply_1",
|
||||
"Unsupported smob application: ~S",
|
||||
SCM_LIST1 (smob));
|
||||
}
|
||||
return SCM_SMOB_APPLY1 (smob, SCM_UNDEFINED);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_smob_apply_2 (SCM smob, SCM a1, SCM a2)
|
||||
static SCM
|
||||
scm_smob_apply_0_020 (SCM smob)
|
||||
{
|
||||
int type = SCM_SMOB_DESCRIPTOR (smob).gsubr_type;
|
||||
switch (type)
|
||||
{
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (1, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 0):
|
||||
scm_wrong_num_args (smob);
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, SCM_LIST2 (a1, a2));
|
||||
case SCM_GSUBR_MAKTYPE (2, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 0):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1, a2);
|
||||
case SCM_GSUBR_MAKTYPE (1, 0, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1, SCM_LIST1 (a2));
|
||||
case SCM_GSUBR_MAKTYPE (2, 1, 0):
|
||||
case SCM_GSUBR_MAKTYPE (1, 2, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 3, 0):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1, a2, SCM_UNDEFINED);
|
||||
case SCM_GSUBR_MAKTYPE (2, 0, 1):
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1, a2, SCM_EOL);
|
||||
default:
|
||||
if (SCM_GSUBR_REQ (type) > 2)
|
||||
scm_wrong_num_args (smob);
|
||||
scm_misc_error ("scm_smob_apply_2",
|
||||
"Unsupported smob application: ~S",
|
||||
SCM_LIST1 (smob));
|
||||
}
|
||||
return SCM_SMOB_APPLY2 (smob, SCM_UNDEFINED, SCM_UNDEFINED);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_smob_apply_3 (SCM smob, SCM a1, SCM a2, SCM rest)
|
||||
static SCM
|
||||
scm_smob_apply_0_030 (SCM smob)
|
||||
{
|
||||
int type = SCM_SMOB_DESCRIPTOR (smob).gsubr_type;
|
||||
switch (type)
|
||||
{
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (1, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 0):
|
||||
case SCM_GSUBR_MAKTYPE (2, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 0):
|
||||
scm_wrong_num_args (smob);
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, scm_cons (a1, scm_cons (a2, rest)));
|
||||
case SCM_GSUBR_MAKTYPE (1, 0, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1, scm_cons (a2, rest));
|
||||
case SCM_GSUBR_MAKTYPE (3, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (2, 1, 0):
|
||||
case SCM_GSUBR_MAKTYPE (1, 2, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 3, 0):
|
||||
if (!SCM_NULLP (SCM_CDR (rest)))
|
||||
scm_wrong_num_args (smob);
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1, a2, SCM_CAR (rest));
|
||||
case SCM_GSUBR_MAKTYPE (2, 0, 1):
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 1):
|
||||
return SCM_SMOB_DESCRIPTOR (smob).apply (smob, a1, a2, rest);
|
||||
default:
|
||||
if (SCM_GSUBR_REQ (type) > 3)
|
||||
scm_wrong_num_args (smob);
|
||||
scm_misc_error ("scm_smob_apply_3",
|
||||
"Unsupported smob application: ~S",
|
||||
SCM_LIST1 (smob));
|
||||
}
|
||||
return SCM_SMOB_APPLY3 (smob, SCM_UNDEFINED, SCM_UNDEFINED, SCM_UNDEFINED);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_0_001 (SCM smob)
|
||||
{
|
||||
return SCM_SMOB_APPLY1 (smob, SCM_EOL);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_0_011 (SCM smob)
|
||||
{
|
||||
return SCM_SMOB_APPLY2 (smob, SCM_UNDEFINED, SCM_EOL);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_0_021 (SCM smob)
|
||||
{
|
||||
return SCM_SMOB_APPLY3 (smob, SCM_UNDEFINED, SCM_UNDEFINED, SCM_EOL);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_0_error (SCM smob)
|
||||
{
|
||||
scm_wrong_num_args (smob);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_1_010 (SCM smob, SCM a1)
|
||||
{
|
||||
return SCM_SMOB_APPLY1 (smob, a1);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_1_020 (SCM smob, SCM a1)
|
||||
{
|
||||
return SCM_SMOB_APPLY2 (smob, a1, SCM_UNDEFINED);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_1_030 (SCM smob, SCM a1)
|
||||
{
|
||||
return SCM_SMOB_APPLY3 (smob, a1, SCM_UNDEFINED, SCM_UNDEFINED);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_1_001 (SCM smob, SCM a1)
|
||||
{
|
||||
return SCM_SMOB_APPLY1 (smob, SCM_LIST1 (a1));
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_1_011 (SCM smob, SCM a1)
|
||||
{
|
||||
return SCM_SMOB_APPLY2 (smob, a1, SCM_EOL);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_1_021 (SCM smob, SCM a1)
|
||||
{
|
||||
return SCM_SMOB_APPLY3 (smob, a1, SCM_UNDEFINED, SCM_EOL);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_1_error (SCM smob, SCM a1)
|
||||
{
|
||||
scm_wrong_num_args (smob);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_2_020 (SCM smob, SCM a1, SCM a2)
|
||||
{
|
||||
return SCM_SMOB_APPLY2 (smob, a1, a2);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_2_030 (SCM smob, SCM a1, SCM a2)
|
||||
{
|
||||
return SCM_SMOB_APPLY3 (smob, a1, a2, SCM_UNDEFINED);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_2_001 (SCM smob, SCM a1, SCM a2)
|
||||
{
|
||||
return SCM_SMOB_APPLY1 (smob, SCM_LIST2 (a1, a2));
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_2_011 (SCM smob, SCM a1, SCM a2)
|
||||
{
|
||||
return SCM_SMOB_APPLY2 (smob, a1, SCM_LIST1 (a2));
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_2_021 (SCM smob, SCM a1, SCM a2)
|
||||
{
|
||||
return SCM_SMOB_APPLY3 (smob, a1, a2, SCM_EOL);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_2_error (SCM smob, SCM a1, SCM a2)
|
||||
{
|
||||
scm_wrong_num_args (smob);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_3_030 (SCM smob, SCM a1, SCM a2, SCM rst)
|
||||
{
|
||||
if (!SCM_NULLP (SCM_CDR (rst)))
|
||||
scm_wrong_num_args (smob);
|
||||
return SCM_SMOB_APPLY3 (smob, a1, a2, SCM_CAR (rst));
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_3_001 (SCM smob, SCM a1, SCM a2, SCM rst)
|
||||
{
|
||||
return SCM_SMOB_APPLY1 (smob, scm_cons2 (a1, a2, rst));
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_3_011 (SCM smob, SCM a1, SCM a2, SCM rst)
|
||||
{
|
||||
return SCM_SMOB_APPLY2 (smob, a1, scm_cons (a2, rst));
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_3_021 (SCM smob, SCM a1, SCM a2, SCM rst)
|
||||
{
|
||||
return SCM_SMOB_APPLY3 (smob, a1, a2, rst);
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_smob_apply_3_error (SCM smob, SCM a1, SCM a2, SCM rst)
|
||||
{
|
||||
scm_wrong_num_args (smob);
|
||||
}
|
||||
|
||||
|
||||
long
|
||||
scm_make_smob_type (char *name, scm_sizet size)
|
||||
{
|
||||
|
|
@ -308,7 +313,10 @@ scm_make_smob_type (char *name, scm_sizet size)
|
|||
scm_smobs[scm_numsmob].print = scm_smob_print;
|
||||
scm_smobs[scm_numsmob].equalp = 0;
|
||||
scm_smobs[scm_numsmob].apply = 0;
|
||||
scm_smobs[scm_numsmob].gsubr_type = 0;
|
||||
scm_smobs[scm_numsmob].apply_0 = 0;
|
||||
scm_smobs[scm_numsmob].apply_1 = 0;
|
||||
scm_smobs[scm_numsmob].apply_2 = 0;
|
||||
scm_smobs[scm_numsmob].apply_3 = 0;
|
||||
scm_numsmob++;
|
||||
}
|
||||
SCM_ALLOW_INTS;
|
||||
|
|
@ -363,8 +371,111 @@ scm_set_smob_equalp (long tc, SCM (*equalp) (SCM, SCM))
|
|||
void
|
||||
scm_set_smob_apply (long tc, SCM (*apply) (), int req, int opt, int rst)
|
||||
{
|
||||
SCM (*apply_0) (SCM);
|
||||
SCM (*apply_1) (SCM, SCM);
|
||||
SCM (*apply_2) (SCM, SCM, SCM);
|
||||
SCM (*apply_3) (SCM, SCM, SCM, SCM);
|
||||
int type = SCM_GSUBR_MAKTYPE (req, opt, rst);
|
||||
|
||||
if (!(req >= 0 && opt >= 0 && (rst == 0 || rst == 1)
|
||||
&& req + opt + rst <= 3))
|
||||
{
|
||||
puts ("Unsupported smob application type");
|
||||
abort ();
|
||||
}
|
||||
|
||||
switch (type)
|
||||
{
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 0):
|
||||
apply_0 = scm_smob_apply_0_000; break;
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 0):
|
||||
apply_0 = scm_smob_apply_0_010; break;
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 0):
|
||||
apply_0 = scm_smob_apply_0_020; break;
|
||||
case SCM_GSUBR_MAKTYPE (0, 3, 0):
|
||||
apply_0 = scm_smob_apply_0_030; break;
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 1):
|
||||
apply_0 = scm_smob_apply_0_001; break;
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 1):
|
||||
apply_0 = scm_smob_apply_0_011; break;
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 1):
|
||||
apply_0 = scm_smob_apply_0_021; break;
|
||||
default:
|
||||
apply_0 = scm_smob_apply_0_error; break;
|
||||
}
|
||||
|
||||
switch (type)
|
||||
{
|
||||
case SCM_GSUBR_MAKTYPE (1, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 0):
|
||||
apply_1 = scm_smob_apply_1_010; break;
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 0):
|
||||
apply_1 = scm_smob_apply_1_020; break;
|
||||
case SCM_GSUBR_MAKTYPE (1, 2, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 3, 0):
|
||||
apply_1 = scm_smob_apply_1_030; break;
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 1):
|
||||
apply_1 = scm_smob_apply_1_001; break;
|
||||
case SCM_GSUBR_MAKTYPE (1, 0, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 1):
|
||||
apply_1 = scm_smob_apply_1_011; break;
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 1):
|
||||
apply_1 = scm_smob_apply_1_021; break;
|
||||
default:
|
||||
apply_1 = scm_smob_apply_1_error; break;
|
||||
}
|
||||
|
||||
switch (type)
|
||||
{
|
||||
case SCM_GSUBR_MAKTYPE (2, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 0):
|
||||
apply_2 = scm_smob_apply_2_020; break;
|
||||
case SCM_GSUBR_MAKTYPE (2, 1, 0):
|
||||
case SCM_GSUBR_MAKTYPE (1, 2, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 3, 0):
|
||||
apply_2 = scm_smob_apply_2_030; break;
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 1):
|
||||
apply_2 = scm_smob_apply_2_001; break;
|
||||
case SCM_GSUBR_MAKTYPE (1, 0, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 1):
|
||||
apply_2 = scm_smob_apply_2_011; break;
|
||||
case SCM_GSUBR_MAKTYPE (2, 0, 1):
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 1):
|
||||
apply_2 = scm_smob_apply_2_021; break;
|
||||
default:
|
||||
apply_2 = scm_smob_apply_2_error; break;
|
||||
}
|
||||
|
||||
switch (type)
|
||||
{
|
||||
case SCM_GSUBR_MAKTYPE (3, 0, 0):
|
||||
case SCM_GSUBR_MAKTYPE (2, 1, 0):
|
||||
case SCM_GSUBR_MAKTYPE (1, 2, 0):
|
||||
case SCM_GSUBR_MAKTYPE (0, 3, 0):
|
||||
apply_3 = scm_smob_apply_3_030; break;
|
||||
case SCM_GSUBR_MAKTYPE (0, 0, 1):
|
||||
apply_3 = scm_smob_apply_3_001; break;
|
||||
case SCM_GSUBR_MAKTYPE (1, 0, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 1, 1):
|
||||
apply_3 = scm_smob_apply_3_011; break;
|
||||
case SCM_GSUBR_MAKTYPE (2, 0, 1):
|
||||
case SCM_GSUBR_MAKTYPE (1, 1, 1):
|
||||
case SCM_GSUBR_MAKTYPE (0, 2, 1):
|
||||
apply_3 = scm_smob_apply_3_021; break;
|
||||
default:
|
||||
apply_3 = scm_smob_apply_3_error; break;
|
||||
}
|
||||
|
||||
scm_smobs[SCM_TC2SMOBNUM (tc)].gsubr_type = type; /* Used in procprop.c */
|
||||
scm_smobs[SCM_TC2SMOBNUM (tc)].apply = apply;
|
||||
scm_smobs[SCM_TC2SMOBNUM (tc)].gsubr_type = SCM_GSUBR_MAKTYPE (req, opt, rst);
|
||||
scm_smobs[SCM_TC2SMOBNUM (tc)].apply_0 = apply_0;
|
||||
scm_smobs[SCM_TC2SMOBNUM (tc)].apply_1 = apply_1;
|
||||
scm_smobs[SCM_TC2SMOBNUM (tc)].apply_2 = apply_2;
|
||||
scm_smobs[SCM_TC2SMOBNUM (tc)].apply_3 = apply_3;
|
||||
}
|
||||
|
||||
void
|
||||
|
|
|
|||
|
|
@ -57,8 +57,12 @@ typedef struct scm_smob_descriptor
|
|||
scm_sizet (*free) (SCM);
|
||||
int (*print) (SCM exp, SCM port, scm_print_state *pstate);
|
||||
SCM (*equalp) (SCM, SCM);
|
||||
SCM (*apply) ();
|
||||
int gsubr_type;
|
||||
SCM (*apply) ();
|
||||
SCM (*apply_0) (SCM);
|
||||
SCM (*apply_1) (SCM, SCM);
|
||||
SCM (*apply_2) (SCM, SCM, SCM);
|
||||
SCM (*apply_3) (SCM, SCM, SCM, SCM);
|
||||
} scm_smob_descriptor;
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue