diff options
author | Keisuke Nishida <kxn30@po.cwru.edu> | 2000-12-07 07:10:26 +0000 |
---|---|---|
committer | Keisuke Nishida <kxn30@po.cwru.edu> | 2000-12-07 07:10:26 +0000 |
commit | 68b069240f6039116c62a62c51ca0ea32e6ff92f (patch) | |
tree | 03143d9190c104fad783b31d785e00f96dd06645 /libguile | |
parent | 23cc31b8ee07cb9f18d706d8a971fda5cf0ed0c0 (diff) | |
download | guile-68b069240f6039116c62a62c51ca0ea32e6ff92f.tar.gz |
Some cleanup on smob calls.
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/ChangeLog | 8 | ||||
-rw-r--r-- | libguile/eval.c | 36 | ||||
-rw-r--r-- | libguile/procprop.c | 2 | ||||
-rw-r--r-- | libguile/smob.c | 3 | ||||
-rw-r--r-- | libguile/smob.h | 7 |
5 files changed, 34 insertions, 22 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index f24abe03b..25cfb5d63 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -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> * smob.h (scm_smob_descriptor): New fields `apply_0', `apply_1', diff --git a/libguile/eval.c b/libguile/eval.c index dc1f0905a..dbabf73af 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -2578,9 +2578,9 @@ evapply: case scm_tc7_asubr: RETURN (SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED)); case scm_tc7_smob: - if (!SCM_SMOB_DESCRIPTOR (proc).apply) + if (!SCM_SMOB_APPLICABLE_P (proc)) goto badfun; - RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_0 (proc)); + RETURN (SCM_SMOB_APPLY_0 (proc)); case scm_tc7_cclo: t.arg1 = proc; proc = SCM_CCLO_SUBR (proc); @@ -2727,9 +2727,9 @@ evapply: RETURN (SCM_SUBRF (proc) (scm_cons (t.arg1, SCM_EOL))); #endif case scm_tc7_smob: - if (!SCM_SMOB_DESCRIPTOR (proc).apply) + if (!SCM_SMOB_APPLICABLE_P (proc)) goto badfun; - RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_1 (proc, t.arg1)); + RETURN (SCM_SMOB_APPLY_1 (proc, t.arg1)); case scm_tc7_cclo: arg2 = t.arg1; t.arg1 = proc; @@ -2843,9 +2843,9 @@ evapply: case scm_tc7_asubr: RETURN (SCM_SUBRF (proc) (t.arg1, arg2)); case scm_tc7_smob: - if (!SCM_SMOB_DESCRIPTOR (proc).apply) + if (!SCM_SMOB_APPLICABLE_P (proc)) goto badfun; - RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_2 (proc, t.arg1, arg2)); + RETURN (SCM_SMOB_APPLY_2 (proc, t.arg1, arg2)); cclon: case scm_tc7_cclo: #ifdef DEVAL @@ -2982,10 +2982,10 @@ evapply: case scm_tc7_lsubr: RETURN (SCM_SUBRF (proc) (debug.info->a.args)) case scm_tc7_smob: - if (!SCM_SMOB_DESCRIPTOR (proc).apply) + if (!SCM_SMOB_APPLICABLE_P (proc)) goto badfun; - RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_3 - (proc, t.arg1, arg2, SCM_CDDR (debug.info->a.args))); + RETURN (SCM_SMOB_APPLY_3 (proc, t.arg1, arg2, + SCM_CDDR (debug.info->a.args))); case scm_tc7_cclo: goto cclon; case scm_tc7_pws: @@ -3044,10 +3044,10 @@ evapply: arg2, scm_eval_args (x, env, proc)))); case scm_tc7_smob: - if (!SCM_SMOB_DESCRIPTOR (proc).apply) + if (!SCM_SMOB_APPLICABLE_P (proc)) goto badfun; - RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_3 - (proc, t.arg1, arg2, scm_eval_args (x, env, proc))); + RETURN (SCM_SMOB_APPLY_3 (proc, t.arg1, arg2, + scm_eval_args (x, env, proc))); case scm_tc7_cclo: goto cclon; case scm_tc7_pws: @@ -3409,18 +3409,16 @@ tail: } RETURN (EVALCAR (proc, args)); case scm_tc7_smob: - if (!SCM_SMOB_DESCRIPTOR (proc).apply) + if (!SCM_SMOB_APPLICABLE_P (proc)) goto badproc; if (SCM_UNBNDP (arg1)) - RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_0 (proc)) + RETURN (SCM_SMOB_APPLY_0 (proc)) 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))) - RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_2 - (proc, arg1, SCM_CAR (args))) + RETURN (SCM_SMOB_APPLY_2 (proc, arg1, SCM_CAR (args))) else - RETURN (SCM_SMOB_DESCRIPTOR (proc).apply_3 - (proc, arg1, SCM_CAR (args), SCM_CDR (args))); + RETURN (SCM_SMOB_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); diff --git a/libguile/procprop.c b/libguile/procprop.c index 9d9a131eb..f0ec8dd2e 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -98,7 +98,7 @@ scm_i_procedure_arity (SCM proc) r = 1; break; case scm_tc7_smob: - if (SCM_SMOB_DESCRIPTOR (proc).apply) + if (SCM_SMOB_APPLICABLE_P (proc)) { int type = SCM_SMOB_DESCRIPTOR (proc).gsubr_type; a += SCM_GSUBR_REQ (type); diff --git a/libguile/smob.c b/libguile/smob.c index 9475542fd..ca23373bb 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -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_2 = 0; scm_smobs[scm_numsmob].apply_3 = 0; + scm_smobs[scm_numsmob].gsubr_type = 0; scm_numsmob++; } 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; } - 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_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; + scm_smobs[SCM_TC2SMOBNUM (tc)].gsubr_type = type; } void diff --git a/libguile/smob.h b/libguile/smob.h index 96589fb63..437eaccc9 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -57,12 +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); - 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); + int gsubr_type; /* Used in procprop.c */ } scm_smob_descriptor; @@ -119,6 +119,11 @@ do { \ #define SCM_SMOB_PREDICATE(tag, obj) (SCM_NIMP (obj) \ && SCM_TYP16 (obj) == (tag)) #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 scm_smob_descriptor *scm_smobs; |