summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog13
-rw-r--r--libguile/debug.c4
-rw-r--r--libguile/eval.c26
-rw-r--r--libguile/goops.c7
-rw-r--r--libguile/procs.c2
-rw-r--r--libguile/procs.h1
-rw-r--r--libguile/sort.c2
-rw-r--r--libguile/stacks.c2
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;
}