* debug.h (SCM_RESET_DEBUG_MODE): switch to debugging if

memoize-symbol is set.

* eval.h (SCM_MEMOIZE_HDLR): add macros for memoize symbol trap.

* eval.c (CEVAL): add memoize_symbol trap.

* read.c: idem.

* eval.c: terminate option lists with 0.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 58f662c..da886ba 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,5 +1,12 @@
 2007-01-19  Han-Wen Nienhuys  <hanwen@lilypond.org>
 
+       * debug.h (SCM_RESET_DEBUG_MODE): switch to debugging if
+       memoize-symbol is set.
+
+       * eval.h (SCM_MEMOIZE_HDLR): add macros for memoize symbol trap.
+
+       * eval.c (CEVAL): add memoize_symbol trap.
+
        * options.c (scm_options_try): new function. This allows error
        reporting before changing options in a critical section.
 

diff --git a/libguile/debug.h b/libguile/debug.h
index c292004..ce7dcfe 100644 (file)
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -64,6 +64,7 @@ SCM_API int scm_debug_mode_p;
 SCM_API int scm_check_entry_p;
 SCM_API int scm_check_apply_p;
 SCM_API int scm_check_exit_p;
+SCM_API int scm_check_memoize_p;
 
 #define SCM_RESET_DEBUG_MODE \
 do {\
@@ -73,8 +74,10 @@ do {\
     && scm_is_true (SCM_APPLY_FRAME_HDLR);\
   scm_check_exit_p = (SCM_EXIT_FRAME_P || SCM_TRACE_P)\
     && scm_is_true (SCM_EXIT_FRAME_HDLR);\
+  scm_check_memoize_p = (SCM_MEMOIZE_P)\
+    && scm_is_true (SCM_MEMOIZE_HDLR);\
   scm_debug_mode_p = SCM_DEVAL_P\
-    || scm_check_entry_p || scm_check_apply_p || scm_check_exit_p;\
+    || scm_check_memoize_p || scm_check_entry_p || scm_check_apply_p || scm_check_exit_p;\
 } while (0)
 
 /* {Evaluator}

diff --git a/libguile/eval.c b/libguile/eval.c
index 9c58756..cfbf5f3 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -99,6 +99,7 @@ static SCM *scm_lookupcar1 (SCM vloc, SCM genv, int check);
 static SCM unmemoize_builtin_macro (SCM expr, SCM env);
 static void eval_letrec_inits (SCM env, SCM init_forms, SCM **init_values_eol);
 
+
 \f
 
 /* {Syntax Errors}
@@ -2555,6 +2556,7 @@ scm_unmemocar (SCM form, SCM env)
 SCM_GLOBAL_SYMBOL (scm_sym_enter_frame, "enter-frame");
 SCM_GLOBAL_SYMBOL (scm_sym_apply_frame, "apply-frame");
 SCM_GLOBAL_SYMBOL (scm_sym_exit_frame, "exit-frame");
+SCM_GLOBAL_SYMBOL (scm_sym_memoize_symbol, "memoize-symbol");
 SCM_GLOBAL_SYMBOL (scm_sym_trace, "trace");
 SCM_SYMBOL (sym_instead, "instead");
 
@@ -3061,6 +3063,7 @@ int scm_debug_mode_p;
 int scm_check_entry_p;
 int scm_check_apply_p;
 int scm_check_exit_p;
+int scm_check_memoize_p;
 
 long scm_eval_stack;
 
@@ -3094,18 +3097,24 @@ scm_t_option scm_debug_opts[] = {
 };
 
 
-
+/*
+  this ordering is awkward and illogical, but we maintain it for
+  compatibility. --hwn
+*/
 scm_t_option scm_evaluator_trap_table[] = {
   { SCM_OPTION_BOOLEAN, "traps", 0, "Enable evaluator traps." },
   { SCM_OPTION_BOOLEAN, "enter-frame", 0, "Trap when eval enters new frame." },
-  { SCM_OPTION_SCM, "enter-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for enter-frame traps." },
   { SCM_OPTION_BOOLEAN, "apply-frame", 0, "Trap when entering apply." },
-  { SCM_OPTION_SCM, "apply-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for apply-frame traps." },
   { SCM_OPTION_BOOLEAN, "exit-frame", 0, "Trap when exiting eval or apply." },
+  { SCM_OPTION_SCM, "enter-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for enter-frame traps." },
+  { SCM_OPTION_SCM, "apply-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for apply-frame traps." },
   { SCM_OPTION_SCM, "exit-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for exit-frame traps." },
+  { SCM_OPTION_BOOLEAN, "memoize-symbol", 0, "Trap when memoizing a symbol." },
+  { SCM_OPTION_SCM, "memoize-symbol-handler", (unsigned long)SCM_BOOL_F, "The handler for memoization." },
   { 0 }
 };
 
+
 SCM_DEFINE (scm_eval_options_interface, "eval-options-interface", 0, 1, 0, 
             (SCM setting),
            "Option interface for the evaluation options. Instead of using\n"
@@ -3134,10 +3143,16 @@ SCM_DEFINE (scm_evaluator_traps, "evaluator-traps-interface", 0, 1, 0,
 #define FUNC_NAME s_scm_evaluator_traps
 {
   SCM ans;
+
+  
+  scm_options_try (setting,
+                  scm_evaluator_trap_table,
+                  FUNC_NAME, 1);
   SCM_CRITICAL_SECTION_START;
   ans = scm_options (setting,
                     scm_evaluator_trap_table,
                     FUNC_NAME);
+
   /* njrev: same again. */
   SCM_RESET_DEBUG_MODE;
   SCM_CRITICAL_SECTION_END;
@@ -3404,7 +3419,7 @@ dispatch:
             else if (SCM_VARIABLEP (last_form))
               RETURN (SCM_VARIABLE_REF (last_form));
             else if (scm_is_symbol (last_form))
-              RETURN (*scm_lookupcar (x, env, 1));
+             RETURN (*scm_lookupcar (x, env, 1));
             else
               RETURN (last_form);
           }
@@ -4034,6 +4049,23 @@ dispatch:
                goto dispatch;
              }
            proc = *location;
+#ifdef DEVAL
+           if (scm_check_memoize_p && SCM_TRAPS_P)
+             {
+               SCM_CLEAR_TRACED_FRAME (debug);
+               SCM arg1 = scm_make_debugobj (&debug);
+               SCM retval = SCM_BOOL_T;
+               SCM_TRAPS_P = 0;
+               retval = scm_call_4 (SCM_MEMOIZE_HDLR,
+                                    scm_sym_memoize_symbol,
+                                    arg1, x, env);
+
+               /*
+                 do something with retval? 
+                */
+               SCM_TRAPS_P = 1;
+             }
+#endif
          }
 
          if (SCM_MACROP (proc))
@@ -4098,7 +4130,7 @@ dispatch:
            }
        }
       else
-        proc = SCM_CAR (x);
+       proc = SCM_CAR (x);
 
       if (SCM_MACROP (proc))
        goto handle_a_macro;
@@ -4114,6 +4146,7 @@ dispatch:
    * level.  If the number of arguments does not match the number of arguments
    * that are allowed to be passed to proc, also an error on the scheme level
    * will be signalled.  */
+
   PREP_APPLY (proc, SCM_EOL);
   if (scm_is_null (SCM_CDR (x))) {
     ENTER_APPLY;

diff --git a/libguile/eval.h b/libguile/eval.h
index cc6f8e1..dec9983 100644 (file)
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -43,13 +43,16 @@ SCM_API scm_t_option scm_evaluator_trap_table[];
 
 SCM_API SCM scm_eval_options_interface (SCM setting);
 
-#define SCM_TRAPS_P           scm_evaluator_trap_table[0].val
+
+#define SCM_TRAPS_P            scm_evaluator_trap_table[0].val
 #define SCM_ENTER_FRAME_P      scm_evaluator_trap_table[1].val
-#define SCM_ENTER_FRAME_HDLR   (SCM_PACK (scm_evaluator_trap_table[2].val))
-#define SCM_APPLY_FRAME_P      scm_evaluator_trap_table[3].val
-#define SCM_APPLY_FRAME_HDLR   (SCM_PACK (scm_evaluator_trap_table[4].val))
-#define SCM_EXIT_FRAME_P       scm_evaluator_trap_table[5].val
+#define SCM_APPLY_FRAME_P      scm_evaluator_trap_table[2].val
+#define SCM_EXIT_FRAME_P       scm_evaluator_trap_table[3].val
+#define SCM_ENTER_FRAME_HDLR   (SCM_PACK (scm_evaluator_trap_table[4].val))
+#define SCM_APPLY_FRAME_HDLR   (SCM_PACK (scm_evaluator_trap_table[5].val))
 #define SCM_EXIT_FRAME_HDLR    (SCM_PACK (scm_evaluator_trap_table[6].val))
+#define SCM_MEMOIZE_P       scm_evaluator_trap_table[7].val
+#define SCM_MEMOIZE_HDLR    (SCM_PACK (scm_evaluator_trap_table[8].val))
 
 \f