diff options
-rw-r--r-- | libguile/ChangeLog | 13 | ||||
-rw-r--r-- | libguile/debug.c | 4 | ||||
-rw-r--r-- | libguile/eval.c | 26 | ||||
-rw-r--r-- | libguile/goops.c | 7 | ||||
-rw-r--r-- | libguile/procs.c | 2 | ||||
-rw-r--r-- | libguile/procs.h | 1 | ||||
-rw-r--r-- | libguile/sort.c | 2 | ||||
-rw-r--r-- | libguile/stacks.c | 2 |
8 files changed, 35 insertions, 22 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index db2319ff5..5e35c4127 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,16 @@ +2002-01-10 Dirk Herrmann <D.Herrmann@tu-bs.de> + + * procs.h (SCM_CLOSURE_BODY): New Macro. + + * debug.c (scm_procedure_name, scm_procedure_source), eval.c + (SCM_CEVAL, SCM_APPLY), goops.c (scm_sys_initialize_object, + get_slot_value, set_slot_value), procs.c + (scm_procedure_documentation), sort.c (closureless), stacks.c + (get_applybody): Replace SCM_CDR (SCM_CODE (...)) by + SCM_CLOSURE_BODY. + + * sort.c (closureless): Prefer !SCM_FOOP over SCM_NFOOP. + 2001-12-26 Marius Vollmer <mvo@zagadka.ping.de> * Makefile.am (guile-procedures.txt): When we don't have makeinfo, diff --git a/libguile/debug.c b/libguile/debug.c index 6b930711c..82b647b3a 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -362,7 +362,7 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0, SCM name = scm_procedure_property (proc, scm_sym_name); #if 0 /* Source property scm_sym_procname not implemented yet... */ - SCM name = scm_source_property (SCM_CADR (SCM_CODE (proc)), scm_sym_procname); + SCM name = scm_source_property (SCM_CAR (SCM_CLOSURE_BODY (proc)), scm_sym_procname); if (SCM_FALSEP (name)) name = scm_procedure_property (proc, scm_sym_name); #endif @@ -384,7 +384,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, case scm_tcs_closures: { SCM formals = SCM_CLOSURE_FORMALS (proc); - SCM src = scm_source_property (SCM_CDR (SCM_CODE (proc)), scm_sym_copy); + SCM src = scm_source_property (SCM_CLOSURE_BODY (proc), scm_sym_copy); if (!SCM_FALSEP (src)) return scm_cons2 (scm_sym_lambda, formals, src); return scm_cons (scm_sym_lambda, diff --git a/libguile/eval.c b/libguile/eval.c index ec0118f8e..c44ca2738 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -2320,8 +2320,8 @@ dispatch: } env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), argl, SCM_ENV (proc)); - x = SCM_CODE (proc); - goto nontoplevel_cdrxbegin; + x = SCM_CLOSURE_BODY (proc); + goto nontoplevel_begin; } proc = scm_f_apply; goto evapply; @@ -2754,9 +2754,9 @@ evapply: if (scm_badformalsp (proc, 0)) goto umwrongnumargs; case scm_tcs_closures: - x = SCM_CODE (proc); + x = SCM_CLOSURE_BODY (proc); env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), SCM_EOL, SCM_ENV (proc)); - goto nontoplevel_cdrxbegin; + goto nontoplevel_begin; case scm_tcs_struct: if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC) { @@ -2895,13 +2895,13 @@ evapply: goto umwrongnumargs; case scm_tcs_closures: /* clos1: */ - x = SCM_CODE (proc); + x = SCM_CLOSURE_BODY (proc); #ifdef DEVAL env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), debug.info->a.args, SCM_ENV (proc)); #else env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), scm_list_1 (t.arg1), SCM_ENV (proc)); #endif - goto nontoplevel_cdrxbegin; + goto nontoplevel_begin; case scm_tcs_struct: if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC) { @@ -3059,8 +3059,8 @@ evapply: env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), scm_list_2 (t.arg1, arg2), SCM_ENV (proc)); #endif - x = SCM_CODE (proc); - goto nontoplevel_cdrxbegin; + x = SCM_CLOSURE_BODY (proc); + goto nontoplevel_begin; } } #ifdef SCM_CAUTIOUS @@ -3137,8 +3137,8 @@ evapply: env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), debug.info->a.args, SCM_ENV (proc)); - x = SCM_CODE (proc); - goto nontoplevel_cdrxbegin; + x = SCM_CLOSURE_BODY (proc); + goto nontoplevel_begin; #else /* DEVAL */ case scm_tc7_subr_3: SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs); @@ -3209,8 +3209,8 @@ evapply: arg2, scm_eval_args (x, env, proc)), SCM_ENV (proc)); - x = SCM_CODE (proc); - goto nontoplevel_cdrxbegin; + x = SCM_CLOSURE_BODY (proc); + goto nontoplevel_begin; #endif /* DEVAL */ case scm_tcs_struct: if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC) @@ -3603,7 +3603,7 @@ tail: } args = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), args, SCM_ENV (proc)); - proc = SCM_CDR (SCM_CODE (proc)); + proc = SCM_CLOSURE_BODY (proc); again: arg1 = proc; while (!SCM_NULLP (arg1 = SCM_CDR (arg1))) diff --git a/libguile/goops.c b/libguile/goops.c index 305f577b3..a3b179c72 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -461,8 +461,7 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0, set_slot_value (class, obj, SCM_CAR (get_n_set), - scm_eval_body (SCM_CDR (SCM_CODE (tmp)), - env)); + scm_eval_body (SCM_CLOSURE_BODY (tmp), env)); } } } @@ -1089,7 +1088,7 @@ get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef) scm_list_1 (obj), SCM_ENV (code)); /* Evaluate the closure body */ - return scm_eval_body (SCM_CDR (SCM_CODE (code)), env); + return scm_eval_body (SCM_CLOSURE_BODY (code), env); } } @@ -1128,7 +1127,7 @@ set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value) scm_list_2 (obj, value), SCM_ENV (code)); /* Evaluate the closure body */ - scm_eval_body (SCM_CDR (SCM_CODE (code)), env); + scm_eval_body (SCM_CLOSURE_BODY (code), env); } } return SCM_UNSPECIFIED; diff --git a/libguile/procs.c b/libguile/procs.c index c53e532e2..04db7708a 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -279,7 +279,7 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0, switch (SCM_TYP7 (proc)) { case scm_tcs_closures: - code = SCM_CDR (SCM_CODE (proc)); + code = SCM_CLOSURE_BODY (proc); if (SCM_IMP (SCM_CDR (code))) return SCM_BOOL_F; code = SCM_CAR (code); diff --git a/libguile/procs.h b/libguile/procs.h index c60c50ac0..4bc1f0c74 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -94,6 +94,7 @@ typedef struct #define SCM_CLOSCAR(x) SCM_PACK (SCM_CELL_WORD_0 (x) - scm_tc3_closure) #define SCM_CODE(x) SCM_CAR (SCM_CLOSCAR (x)) #define SCM_CLOSURE_FORMALS(x) SCM_CAR (SCM_CODE (x)) +#define SCM_CLOSURE_BODY(x) SCM_CDR (SCM_CODE (x)) #define SCM_PROCPROPS(x) SCM_CDR (SCM_CLOSCAR (x)) #define SCM_SETPROCPROPS(x, p) SCM_SETCDR (SCM_CLOSCAR (x), p) #define SCM_SETCODE(x, e) (SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (scm_cons ((e), SCM_EOL)) \ diff --git a/libguile/sort.c b/libguile/sort.c index 7519ed2f2..05991b7b3 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -378,7 +378,7 @@ closureless (SCM code, const void *a, const void *b) scm_cons (*(SCM *) b, SCM_EOL)), SCM_ENV (code)); /* Evaluate the closure body */ - return SCM_NFALSEP (scm_eval_body (SCM_CDR (SCM_CODE (code)), env)); + return !SCM_FALSEP (scm_eval_body (SCM_CLOSURE_BODY (code), env)); } /* closureless */ static int diff --git a/libguile/stacks.c b/libguile/stacks.c index 7c73f4671..508b2e28d 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -221,7 +221,7 @@ get_applybody () { SCM var = scm_sym2var (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F); if (SCM_VARIABLEP (var) && SCM_CLOSUREP (SCM_VARIABLE_REF (var))) - return SCM_CADR (SCM_CODE (SCM_VARIABLE_REF (var))); + return SCM_CAR (SCM_CLOSURE_BODY (SCM_VARIABLE_REF (var))); else return SCM_UNDEFINED; } |