api-debug.texi updates

[bpt/guile.git] / libguile / eval.c

diff --git a/libguile/eval.c b/libguile/eval.c
index 7c21060..8d11570 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -24,7 +24,6 @@
 #endif
 
 #include <alloca.h>
-#include <assert.h>
 
 #include "libguile/__scm.h"
 
@@ -37,6 +36,7 @@
 #include "libguile/deprecation.h"
 #include "libguile/dynwind.h"
 #include "libguile/eq.h"
+#include "libguile/expand.h"
 #include "libguile/feature.h"
 #include "libguile/fluids.h"
 #include "libguile/goops.h"
@@ -114,15 +114,26 @@ static scm_t_bits scm_tc16_boot_closure;
 #define BOOT_CLOSURE_IS_REST(x) scm_is_null (CDDDR (BOOT_CLOSURE_CODE (x)))
 /* NB: One may only call the following accessors if the closure is not REST. */
 #define BOOT_CLOSURE_IS_FULL(x) (1)
-#define BOOT_CLOSURE_PARSE_FULL(x,body,nargs,rest,nopt,kw,inits,alt)    \
-  do { SCM mx = BOOT_CLOSURE_CODE (x);                          \
-    body = CAR (mx); mx = CDR (mx);                             \
-    nreq = SCM_I_INUM (CAR (mx)); mx = CDR (mx);                \
-    rest = CAR (mx); mx = CDR (mx);                             \
-    nopt = SCM_I_INUM (CAR (mx)); mx = CDR (mx);                \
-    kw = CAR (mx); mx = CDR (mx);                               \
-    inits = CAR (mx); mx = CDR (mx);                            \
-    alt = CAR (mx);                                             \
+#define BOOT_CLOSURE_PARSE_FULL(fu_,body,nargs,rest,nopt,kw,inits,alt)    \
+  do { SCM fu = fu_;                                            \
+    body = CAR (fu); fu = CDR (fu);                             \
+                                                                \
+    rest = kw = alt = SCM_BOOL_F;                               \
+    inits = SCM_EOL;                                            \
+    nopt = 0;                                                   \
+                                                                \
+    nreq = SCM_I_INUM (CAR (fu)); fu = CDR (fu);                \
+    if (scm_is_pair (fu))                                       \
+      {                                                         \
+        rest = CAR (fu); fu = CDR (fu);                         \
+        if (scm_is_pair (fu))                                   \
+          {                                                     \
+            nopt = SCM_I_INUM (CAR (fu)); fu = CDR (fu);        \
+            kw = CAR (fu); fu = CDR (fu);                       \
+            inits = CAR (fu); fu = CDR (fu);                    \
+            alt = CAR (fu);                                     \
+          }                                                     \
+      }                                                         \
   } while (0)
 static void prepare_boot_closure_env_for_apply (SCM proc, SCM args,
                                                 SCM *out_body, SCM *out_env);
@@ -432,10 +443,12 @@ scm_t_option scm_eval_opts[] = {
 scm_t_option scm_debug_opts[] = {
   { SCM_OPTION_BOOLEAN, "cheap", 1,
     "*This option is now obsolete.  Setting it has no effect." },
-  { SCM_OPTION_BOOLEAN, "breakpoints", 0, "*Check for breakpoints." },
-  { SCM_OPTION_BOOLEAN, "trace", 0, "*Trace mode." },
+  { SCM_OPTION_BOOLEAN, "breakpoints", 0,
+    "*This option is now obsolete.  Setting it has no effect." },
+  { SCM_OPTION_BOOLEAN, "trace", 0,
+    "*This option is now obsolete.  Setting it has no effect." },
   { SCM_OPTION_BOOLEAN, "procnames", 1,
-    "Record procedure names at definition." },
+    "*This option is now obsolete.  Setting it has no effect." },
   { SCM_OPTION_BOOLEAN, "backwards", 0,
     "Display backtrace in anti-chronological order." },
   { SCM_OPTION_INTEGER, "width", 79, "Maximal width of backtrace." },
@@ -821,13 +834,9 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
 static SCM
 scm_c_primitive_eval (SCM exp)
 {
-  if (!SCM_MEMOIZED_P (exp))
+  if (!SCM_EXPANDED_P (exp))
     exp = scm_call_1 (scm_current_module_transformer (), exp);
-  if (!SCM_MEMOIZED_P (exp))
-    scm_misc_error ("primitive-eval",
-                    "expander did not return a memoized expression",
-                    scm_list_1 (exp));
-  return eval (exp, SCM_EOL);
+  return eval (scm_memoize_expression (exp), SCM_EOL);
 }
 
 static SCM var_primitive_eval;
@@ -906,6 +915,7 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
 {
   int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc);
   SCM env = BOOT_CLOSURE_ENV (proc);
+  
   if (BOOT_CLOSURE_IS_FIXED (proc)
       || (BOOT_CLOSURE_IS_REST (proc)
           && !BOOT_CLOSURE_HAS_REST_ARGS (proc)))
@@ -931,16 +941,17 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
     {
       int i, argc, nreq, nopt;
       SCM body, rest, kw, inits, alt;
+      SCM mx = BOOT_CLOSURE_CODE (proc);
       
     loop:
-      BOOT_CLOSURE_PARSE_FULL (proc, body, nargs, rest, nopt, kw, inits, alt);
+      BOOT_CLOSURE_PARSE_FULL (mx, body, nargs, rest, nopt, kw, inits, alt);
 
       argc = scm_ilength (args);
       if (argc < nreq)
         {
           if (scm_is_true (alt))
             {
-              proc = alt;
+              mx = alt;
               goto loop;
             }
           else
@@ -950,7 +961,7 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
         {
           if (scm_is_true (alt))
             {
-              proc = alt;
+              mx = alt;
               goto loop;
             }
           else
@@ -1048,7 +1059,7 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
           }
         }
 
-      *out_body = BOOT_CLOSURE_BODY (proc);
+      *out_body = body;
       *out_env = env;
     }
 }