* 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.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index db2319f..5e35c41 100644 (file)
--- 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 6b93071..82b647b 100644 (file)
--- 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 ec0118f..c44ca27 100644 (file)
--- 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 305f577..a3b179c 100644 (file)
--- 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 c53e532..04db770 100644 (file)
--- 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 c60c50a..4bc1f0c 100644 (file)
--- 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 7519ed2..05991b7 100644 (file)
--- 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 7c73f46..508b2e2 100644 (file)
--- 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;
 }