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

Some cleanup on smob calls.

Browse source
This commit is contained in:
Keisuke Nishida 2000-12-07 07:10:26 +00:00
parent 23cc31b8ee
commit 68b069240f
5 changed files with 34 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/ChangeLog
View file

@ -1,3 +1,11 @@
2000-12-07 Keisuke Nishida <kxn30@po.cwru.edu>
* smob.h (SCM_SMOB_APPLICABLE_P, SCM_SMOB_APPLY_0,
SCM_SMOB_APPLY_1, SCM_SMOB_APPLY_2, SCM_SMOB_APPLY_3): New macros.
* eval.c (SCM_CEVAL, SCM_APPLY): Use macros above.
* procprop.c (scm_i_procedure_arity): Ditto.
* smob.c (scm_make_smob_type): Initialize gsubr_type.
2000-12-06 Keisuke Nishida <kxn30@po.cwru.edu> 2000-12-06 Keisuke Nishida <kxn30@po.cwru.edu>
* smob.h (scm_smob_descriptor): New fields `apply_0', `apply_1', * smob.h (scm_smob_descriptor): New fields `apply_0', `apply_1',

36
libguile/eval.c
View file

@ -2578,9 +2578,9 @@ evapply:
case scm_tc7_asubr: case scm_tc7_asubr:
RETURN (SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED)); RETURN (SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED));
case scm_tc7_smob: case scm_tc7_smob:
if (!SCM_SMOB_DESCRIPTOR (proc).apply) if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun; goto badfun;
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_0 (proc)); RETURN (SCM_SMOB_APPLY_0 (proc));
case scm_tc7_cclo: case scm_tc7_cclo:
t.arg1 = proc; t.arg1 = proc;
proc = SCM_CCLO_SUBR (proc); proc = SCM_CCLO_SUBR (proc);
@ -2727,9 +2727,9 @@ evapply:
RETURN (SCM_SUBRF (proc) (scm_cons (t.arg1, SCM_EOL))); RETURN (SCM_SUBRF (proc) (scm_cons (t.arg1, SCM_EOL)));
#endif #endif
case scm_tc7_smob: case scm_tc7_smob:
if (!SCM_SMOB_DESCRIPTOR (proc).apply) if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun; goto badfun;
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_1 (proc, t.arg1)); RETURN (SCM_SMOB_APPLY_1 (proc, t.arg1));
case scm_tc7_cclo: case scm_tc7_cclo:
arg2 = t.arg1; arg2 = t.arg1;
t.arg1 = proc; t.arg1 = proc;
@ -2843,9 +2843,9 @@ evapply:
case scm_tc7_asubr: case scm_tc7_asubr:
RETURN (SCM_SUBRF (proc) (t.arg1, arg2)); RETURN (SCM_SUBRF (proc) (t.arg1, arg2));
case scm_tc7_smob: case scm_tc7_smob:
if (!SCM_SMOB_DESCRIPTOR (proc).apply) if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun; goto badfun;
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_2 (proc, t.arg1, arg2)); RETURN (SCM_SMOB_APPLY_2 (proc, t.arg1, arg2));
cclon: cclon:
case scm_tc7_cclo: case scm_tc7_cclo:
#ifdef DEVAL #ifdef DEVAL
@ -2982,10 +2982,10 @@ evapply:
case scm_tc7_lsubr: case scm_tc7_lsubr:
RETURN (SCM_SUBRF (proc) (debug.info->a.args)) RETURN (SCM_SUBRF (proc) (debug.info->a.args))
case scm_tc7_smob: case scm_tc7_smob:
if (!SCM_SMOB_DESCRIPTOR (proc).apply) if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun; goto badfun;
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_3 RETURN (SCM_SMOB_APPLY_3 (proc, t.arg1, arg2,
(proc, t.arg1, arg2, SCM_CDDR (debug.info->a.args))); SCM_CDDR (debug.info->a.args)));
case scm_tc7_cclo: case scm_tc7_cclo:
goto cclon; goto cclon;
case scm_tc7_pws: case scm_tc7_pws:
@ -3044,10 +3044,10 @@ evapply:
arg2, arg2,
scm_eval_args (x, env, proc)))); scm_eval_args (x, env, proc))));
case scm_tc7_smob: case scm_tc7_smob:
if (!SCM_SMOB_DESCRIPTOR (proc).apply) if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun; goto badfun;
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_3 RETURN (SCM_SMOB_APPLY_3 (proc, t.arg1, arg2,
(proc, t.arg1, arg2, scm_eval_args (x, env, proc))); scm_eval_args (x, env, proc)));
case scm_tc7_cclo: case scm_tc7_cclo:
goto cclon; goto cclon;
case scm_tc7_pws: case scm_tc7_pws:
@ -3409,18 +3409,16 @@ tail:
} }
RETURN (EVALCAR (proc, args)); RETURN (EVALCAR (proc, args));
case scm_tc7_smob: case scm_tc7_smob:
if (!SCM_SMOB_DESCRIPTOR (proc).apply) if (!SCM_SMOB_APPLICABLE_P (proc))
goto badproc; goto badproc;
if (SCM_UNBNDP (arg1)) if (SCM_UNBNDP (arg1))
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_0 (proc)) RETURN (SCM_SMOB_APPLY_0 (proc))
else if (SCM_NULLP (args)) else if (SCM_NULLP (args))
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_1 (proc, arg1)) RETURN (SCM_SMOB_APPLY_1 (proc, arg1))
else if (SCM_NULLP (SCM_CDR (args))) else if (SCM_NULLP (SCM_CDR (args)))
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_2 RETURN (SCM_SMOB_APPLY_2 (proc, arg1, SCM_CAR (args)))
(proc, arg1, SCM_CAR (args)))
else else
RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_3 RETURN (SCM_SMOB_APPLY_3 (proc, arg1, SCM_CAR (args), SCM_CDR (args)));
(proc, arg1, SCM_CAR (args), SCM_CDR (args)));
case scm_tc7_cclo: case scm_tc7_cclo:
#ifdef DEVAL #ifdef DEVAL
args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args); args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args);

2
libguile/procprop.c
View file

@ -98,7 +98,7 @@ scm_i_procedure_arity (SCM proc)
r = 1; r = 1;
break; break;
case scm_tc7_smob: case scm_tc7_smob:
if (SCM_SMOB_DESCRIPTOR (proc).apply) if (SCM_SMOB_APPLICABLE_P (proc))
{ {
int type = SCM_SMOB_DESCRIPTOR (proc).gsubr_type; int type = SCM_SMOB_DESCRIPTOR (proc).gsubr_type;
a += SCM_GSUBR_REQ (type); a += SCM_GSUBR_REQ (type);

3
libguile/smob.c
View file

@ -317,6 +317,7 @@ scm_make_smob_type (char *name, scm_sizet size)
scm_smobs[scm_numsmob].apply_1 = 0; scm_smobs[scm_numsmob].apply_1 = 0;
scm_smobs[scm_numsmob].apply_2 = 0; scm_smobs[scm_numsmob].apply_2 = 0;
scm_smobs[scm_numsmob].apply_3 = 0; scm_smobs[scm_numsmob].apply_3 = 0;
scm_smobs[scm_numsmob].gsubr_type = 0;
scm_numsmob++; scm_numsmob++;
} }
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
@ -470,12 +471,12 @@ scm_set_smob_apply (long tc, SCM (*apply) (), int req, int opt, int rst)
apply_3 = scm_smob_apply_3_error; break; 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)].apply = apply;
scm_smobs[SCM_TC2SMOBNUM (tc)].apply_0 = apply_0; scm_smobs[SCM_TC2SMOBNUM (tc)].apply_0 = apply_0;
scm_smobs[SCM_TC2SMOBNUM (tc)].apply_1 = apply_1; scm_smobs[SCM_TC2SMOBNUM (tc)].apply_1 = apply_1;
scm_smobs[SCM_TC2SMOBNUM (tc)].apply_2 = apply_2; scm_smobs[SCM_TC2SMOBNUM (tc)].apply_2 = apply_2;
scm_smobs[SCM_TC2SMOBNUM (tc)].apply_3 = apply_3; scm_smobs[SCM_TC2SMOBNUM (tc)].apply_3 = apply_3;
scm_smobs[SCM_TC2SMOBNUM (tc)].gsubr_type = type;
} }
void void

7
libguile/smob.h
View file

@ -57,12 +57,12 @@ typedef struct scm_smob_descriptor
scm_sizet (*free) (SCM); scm_sizet (*free) (SCM);
int (*print) (SCM exp, SCM port, scm_print_state *pstate); int (*print) (SCM exp, SCM port, scm_print_state *pstate);
SCM (*equalp) (SCM, SCM); SCM (*equalp) (SCM, SCM);
int gsubr_type;
SCM (*apply) (); SCM (*apply) ();
SCM (*apply_0) (SCM); SCM (*apply_0) (SCM);
SCM (*apply_1) (SCM, SCM); SCM (*apply_1) (SCM, SCM);
SCM (*apply_2) (SCM, SCM, SCM); SCM (*apply_2) (SCM, SCM, SCM);
SCM (*apply_3) (SCM, SCM, SCM, SCM); SCM (*apply_3) (SCM, SCM, SCM, SCM);
int gsubr_type; /* Used in procprop.c */
} scm_smob_descriptor; } scm_smob_descriptor;
@ -119,6 +119,11 @@ do { \
#define SCM_SMOB_PREDICATE(tag, obj) (SCM_NIMP (obj) \ #define SCM_SMOB_PREDICATE(tag, obj) (SCM_NIMP (obj) \
&& SCM_TYP16 (obj) == (tag)) && SCM_TYP16 (obj) == (tag))
#define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)]) #define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)])
#define SCM_SMOB_APPLICABLE_P(x) (SCM_SMOB_DESCRIPTOR (x).apply)
#define SCM_SMOB_APPLY_0(x) (SCM_SMOB_DESCRIPTOR (x).apply_0 (x))
#define SCM_SMOB_APPLY_1(x,a1) (SCM_SMOB_DESCRIPTOR (x).apply_1 (x, (a1)))
#define SCM_SMOB_APPLY_2(x,a1,a2) (SCM_SMOB_DESCRIPTOR (x).apply_2 (x, (a1), (a2)))
#define SCM_SMOB_APPLY_3(x,a1,a2,rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst)))
extern int scm_numsmob; extern int scm_numsmob;
extern scm_smob_descriptor *scm_smobs; extern scm_smob_descriptor *scm_smobs;