[uim-commit] r2126 - branches/r5rs/sigscheme

yamaken at freedesktop.org yamaken at freedesktop.org
Sun Nov 13 07:29:54 PST 2005


Author: yamaken
Date: 2005-11-13 07:29:51 -0800 (Sun, 13 Nov 2005)
New Revision: 2126

Added:
   branches/r5rs/sigscheme/operations-new-srfi34.c
Modified:
   branches/r5rs/sigscheme/Makefile.am
   branches/r5rs/sigscheme/config.h
   branches/r5rs/sigscheme/main.c
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigscheme.h
   branches/r5rs/sigscheme/sigschemefunctable.c
   branches/r5rs/sigscheme/sigschemefunctable.h
   branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* This commit adds new implementation of SRFI-34 to resolve the
  problems. It basically works, but some error-handling related part
  is not yet reorganized. It will be fixed soon.

* sigscheme/config.h
  - (SCM_USE_FORMER_SRFI34, SCM_USE_NEW_SRFI34): New macro
  - Add dependency resolution for SCM_USE_NEW_SRFI34
* sigscheme/sigscheme.h
  - (ScmExp_SRFI34_guard): Add different type definition for
    SCM_USE_NEW_SRFI34
* sigscheme/operations-new-srfi34.c
  - New file
  - (ERRMSG_UNHANDLED_EXCEPTION, ERRMSG_HANDLER_RETURNED,
    MAKE_STR_COPYING, DECLARE_PRIVATE_FUNCTION): New macro
  - (current_exception_handlers, errmsg_unhandled_exception,
    errmsg_handler_returned, sym_error, sym_raise, sym_lex_env,
    sym_cond_catch, sym_body, sym_condition, sym_guard_k,
    sym_handler_k, syn_apply, proc_values, syn_set_cur_handlers,
    proc_fallback_handler, proc_with_exception_handlers,
    syn_guard_internal, syn_guard_handler, syn_guard_handler_body,
    syn_guard_body): New static variable
  - (set_cur_handlers, with_exception_handlers, guard_internal,
    guard_handler, guard_handler_body, guard_body): New static
    function
  - (SigScm_Initialize_SRFI34, ScmOp_SRFI34_with_exception_handler,
    ScmOp_SRFI34_raise, ScmExp_SRFI34_guard): New function
* sigscheme/main.c
  - (repl_loop): Add error-proof evaluation for SCM_USE_NEW_SRFI34
  - (main): prepare SRFI-34 when SCM_USE_SRFI34
* sigscheme/sigschemeinternal.h
  - (scm_exception_handlers, scm_exception_continuations,
    CURRENT_EXCEPTION_HANDLER, PUSH_EXCEPTION_HANDLER,
    POP_EXCEPTION_HANDLER, CURRENT_EXCEPTION_CONTINUATION,
    PUSH_EXCEPTION_CONTINUATION, POP_EXCEPTION_CONTINUATION): Disable
    when SCM_USE_NEW_SRFI34
* sigscheme/sigschemefunctable.h
* sigscheme/sigschemefunctable.c
* sigscheme/operations.c
  - Support SCM_USE_NEW_SRFI34
* sigscheme/Makefile.am
  - (BUILD_FUNCTBL): New variable
  - (FUNC_TABLES): Add sigschemefunctable-new-srfi34.c
  - Add generation rule for sigschemefunctable-new-srfi34.c


Modified: branches/r5rs/sigscheme/Makefile.am
===================================================================
--- branches/r5rs/sigscheme/Makefile.am	2005-11-13 14:32:38 UTC (rev 2125)
+++ branches/r5rs/sigscheme/Makefile.am	2005-11-13 15:29:51 UTC (rev 2126)
@@ -1,3 +1,5 @@
+BUILD_FUNCTBL = ./script/build_func_table.rb
+
 noinst_LTLIBRARIES  = libsscm.la
 
 FUNC_TABLES = \
@@ -11,9 +13,11 @@
 		sigschemefunctable-srfi8.c \
 		sigschemefunctable-srfi23.c \
 		sigschemefunctable-srfi34.c \
+		sigschemefunctable-new-srfi34.c \
 		sigschemefunctable-srfi38.c \
 		sigschemefunctable-srfi60.c
 
+# FIXME: simplify like sigschemefunctable-new-srfi34.c
 sigschemefunctable.c: $(FUNC_TABLES)
 sigschemefunctable-r5rs.c: ./script/build_func_table.rb sigscheme.c operations.c eval.c io.c
 	./script/build_func_table.rb "" "r5rs_func_info_table" "sigscheme.c" "operations.c" "eval.c" "io.c" \
@@ -42,6 +46,8 @@
 sigschemefunctable-srfi34.c: ./script/build_func_table.rb operations-srfi34.c
 	./script/build_func_table.rb "_SRFI34_" "srfi34_func_info_table" "operations-srfi34.c" \
 		> sigschemefunctable-srfi34.c
+sigschemefunctable-new-srfi34.c: operations-new-srfi34.c $(BUILD_FUNCTBL)
+	$(BUILD_FUNCTBL) "_SRFI34_" "scm_new_srfi34_func_info_table" $< > $@
 sigschemefunctable-srfi38.c: ./script/build_func_table.rb operations-srfi38.c
 	./script/build_func_table.rb "_SRFI38_" "srfi38_func_info_table" "operations-srfi38.c" \
 		> sigschemefunctable-srfi38.c
@@ -52,6 +58,7 @@
 	./script/build_func_table.rb "" "siod_func_info_table" "operations-siod.c" \
 		> sigschemefunctable-siod.c
 
+# FIXME: add all distribution files to EXTRA_DIST
 EXTRA_DIST = $(FUNC_TABLES)
 libsscm_la_SOURCES = \
 		storage.c debug.c \

Modified: branches/r5rs/sigscheme/config.h
===================================================================
--- branches/r5rs/sigscheme/config.h	2005-11-13 14:32:38 UTC (rev 2125)
+++ branches/r5rs/sigscheme/config.h	2005-11-13 15:29:51 UTC (rev 2126)
@@ -46,6 +46,8 @@
 #define SCM_USE_SRFI8           1  /* use SRFI-8  'receive' */
 #define SCM_USE_SRFI23          1  /* use SRFI-23 'error' */
 #define SCM_USE_SRFI34          1  /* use SRFI-34 exception handling for programs */
+#define SCM_USE_FORMER_SRFI34   1  /* use former SRFI-34 implementation */
+#define SCM_USE_NEW_SRFI34      0  /* use new SRFI-34 implementation */
 #define SCM_USE_SRFI38          1  /* use SRFI-38 'write-with-shared-structure' */
 #define SCM_USE_SRFI60          1  /* use SRFI-60 integers as bits */
 #define SCM_USE_SRFI75_NAMED_CHARS 1  /* use named characters of SRFI-75 R6RS unicode data */
@@ -129,6 +131,13 @@
 #define SCM_USE_SRFI34          1
 #endif /* SCM_EXCEPTION_HANDLING */
 
+#if SCM_USE_NEW_SRFI34
+#undef SCM_FORMER_SRFI34
+#undef SCM_EXCEPTION_HANDLING
+#undef SCM_USE_SRFI23
+#define SCM_USE_SRFI23          1
+#endif /* SCM_USE_NEW_SRFI34 */
+
 #if SCM_DEBUG
 #undef SCM_VOLATILE_OUTPUT
 #define SCM_VOLATILE_OUTPUT     1

Modified: branches/r5rs/sigscheme/main.c
===================================================================
--- branches/r5rs/sigscheme/main.c	2005-11-13 14:32:38 UTC (rev 2125)
+++ branches/r5rs/sigscheme/main.c	2005-11-13 15:29:51 UTC (rev 2126)
@@ -100,7 +100,32 @@
 
     while (s_exp = SigScm_Read(scm_current_input_port), !EOFP(s_exp)) {
 #if SCM_USE_SRFI34
+#if SCM_USE_NEW_SRFI34
+        /* FIXME: move the fallback exception handling into error.c */
         /*
+         * Error-proof evaluation
+         *
+         * (guard (err
+         *         (else
+         *          (display "unhandled exception: ")
+         *          (write err)
+         *          (newline)
+         *          #<undef>))
+         *   exp)
+         */
+        result = EVAL(LIST_3(Scm_Intern("guard"),
+                             LIST_2(Scm_Intern("err"),
+                                    LIST_5(SYM_ELSE,
+                                           LIST_2(Scm_Intern("display"),
+                                                  Scm_NewStringCopying("unhandled exception: ")),
+                                           LIST_2(Scm_Intern("write"),
+                                                  Scm_Intern("err")),
+                                           LIST_1(Scm_Intern("newline")),
+                                           SCM_UNDEF)),
+                             s_exp),
+                      SCM_INTERACTION_ENV);
+#else /* SCM_USE_NEW_SRFI34 */
+        /*
          * Error Aware repl_loop
          *
          * (guard (err (else #f))
@@ -112,6 +137,7 @@
                                                    LIST_2(SYM_QUOTE, s_exp),
                                                    SCM_INTERACTION_ENV)),
                                      SCM_INTERACTION_ENV);
+#endif /* SCM_USE_NEW_SRFI34 */
 #else /* SCM_USE_SRFI34 */
         result = EVAL(s_exp, SCM_INTERACTION_ENV);
 #endif
@@ -144,6 +170,10 @@
 
     SigScm_Initialize();
 
+#if SCM_USE_SRFI34
+    Scm_use("srfi-34");
+#endif
+
     if (argc < 2) {
 #if SCM_GCC4_READY_GC
         SCM_GC_PROTECTED_CALL_VOID(repl, ());

Added: branches/r5rs/sigscheme/operations-new-srfi34.c
===================================================================
--- branches/r5rs/sigscheme/operations-new-srfi34.c	2005-11-13 14:32:38 UTC (rev 2125)
+++ branches/r5rs/sigscheme/operations-new-srfi34.c	2005-11-13 15:29:51 UTC (rev 2126)
@@ -0,0 +1,332 @@
+/*===========================================================================
+ *  FileName : operations-new-srfi34.c
+ *  About    : New implementation of SRFI-34 exception handling for programs
+ *
+ *  Copyright (C) 2005      by YamaKen (yamaken AT bp.iij4u.or.jp)
+ *
+ *  All rights reserved.
+ *
+ *  Redistribution and use in source and binary forms, with or without
+ *  modification, are permitted provided that the following conditions
+ *  are met:
+ *
+ *  1. Redistributions of source code must retain the above copyright
+ *     notice, this list of conditions and the following disclaimer.
+ *  2. Redistributions in binary form must reproduce the above copyright
+ *     notice, this list of conditions and the following disclaimer in the
+ *     documentation and/or other materials provided with the distribution.
+ *  3. Neither the name of authors nor the names of its contributors
+ *     may be used to endorse or promote products derived from this software
+ *     without specific prior written permission.
+ *
+ *  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ *  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ *  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ *  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ *  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ *  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ *  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ *  OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ *  WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ *  OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ *  ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+===========================================================================*/
+
+/*
+ * This file implements C-version of the reference implementation written in
+ * the SRFI-34 specification. All parts are written in C since:
+ *
+ * - SigScheme doesn't have a hygienic-macros feature (yet)
+ *
+ * - To avoid namespace pollution (with-exception-handlers, guard-aux, etc),
+ *   since SigScheme doesn't have a module or namespace feature (yet)
+ */
+
+/*=======================================
+  System Include
+=======================================*/
+
+/*=======================================
+  Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+  File Local Macro Definitions
+=======================================*/
+#define ERRMSG_UNHANDLED_EXCEPTION "unhandled exception"
+#define ERRMSG_HANDLER_RETURNED    "handler returned"
+
+#define MAKE_STR_COPYING Scm_NewStringCopying
+#define DECLARE_PRIVATE_FUNCTION(func_name, type)                            \
+    DECLARE_INTERNAL_FUNCTION(func_name)
+
+/*=======================================
+  File Local Type Definitions
+=======================================*/
+
+/*=======================================
+  Variable Declarations
+=======================================*/
+static ScmObj current_exception_handlers;
+
+/* error messages */
+static ScmObj errmsg_unhandled_exception, errmsg_handler_returned;
+
+/* symbols */
+static ScmObj sym_error, sym_raise;
+static ScmObj sym_lex_env, sym_cond_catch, sym_body;
+static ScmObj sym_condition, sym_guard_k, sym_handler_k;
+
+/* procedures and syntaxes */
+static ScmObj syn_apply, proc_values;
+static ScmObj syn_set_cur_handlers, proc_fallback_handler;
+static ScmObj proc_with_exception_handlers;
+static ScmObj syn_guard_internal, syn_guard_handler, syn_guard_handler_body;
+static ScmObj syn_guard_body;
+
+/*=======================================
+  File Local Function Declarations
+=======================================*/
+static ScmObj set_cur_handlers(ScmObj handlers, ScmObj env);
+static ScmObj with_exception_handlers(ScmObj new_handlers, ScmObj thunk);
+static ScmObj guard_internal(ScmObj guard_k, ScmObj env);
+static ScmObj guard_handler(ScmObj q_condition, ScmEvalState *eval_state);
+static ScmObj guard_handler_body(ScmObj handler_k, ScmObj env);
+static ScmObj guard_body(ScmEvalState *eval_state);
+
+/*=======================================
+  Function Implementations
+=======================================*/
+void SigScm_Initialize_SRFI34(void)
+{
+    Scm_use("srfi-23");
+
+    errmsg_unhandled_exception = MAKE_STR_COPYING(ERRMSG_UNHANDLED_EXCEPTION);
+    errmsg_handler_returned    = MAKE_STR_COPYING(ERRMSG_HANDLER_RETURNED);
+
+    sym_error      = Scm_Intern("error");
+    sym_raise      = Scm_Intern("raise");
+
+    sym_lex_env    = Scm_Intern("lex-env");
+    sym_cond_catch = Scm_Intern("cond-catch");
+    sym_body       = Scm_Intern("body");
+    sym_condition  = Scm_Intern("condition");
+    sym_guard_k    = Scm_Intern("guard-k");
+    sym_handler_k  = Scm_Intern("handler-k");
+
+    /* prepare procedures and syntaxes */
+    syn_apply   = Scm_SymbolValue(Scm_Intern("apply"),  SCM_INTERACTION_ENV);
+    proc_values = Scm_SymbolValue(Scm_Intern("values"), SCM_INTERACTION_ENV);
+    /* FIXME: make registration type-safe */
+    syn_set_cur_handlers = Scm_NewFunc(SCM_SYNTAX_FIXED | 1,
+                                       &set_cur_handlers);
+    proc_with_exception_handlers = Scm_NewFunc(SCM_PROCEDURE_FIXED | 2,
+                                               &with_exception_handlers);
+    syn_guard_internal = Scm_NewFunc(SCM_SYNTAX_FIXED | 1,
+                                     &guard_internal);
+    syn_guard_handler = Scm_NewFunc(SCM_SYNTAX_FIXED_TAIL_REC | 1,
+                                    &guard_handler);
+    syn_guard_handler_body = Scm_NewFunc(SCM_SYNTAX_FIXED | 1,
+                                         &guard_handler_body);
+    syn_guard_body = Scm_NewFunc(SCM_SYNTAX_FIXED_TAIL_REC | 0,
+                                 &guard_body);
+
+    /*
+     * The 'error' procedure should not be invoked directly by ScmOp_error(),
+     * to allow dynamic redifinition, and keep SRFI-23 implementation abstract.
+     */
+    proc_fallback_handler
+        = ScmExp_lambda(LIST_1(sym_condition),
+                        LIST_1(LIST_3(sym_error,
+                                      errmsg_unhandled_exception,
+                                      sym_condition)),
+                        SCM_INTERACTION_ENV);
+
+    REGISTER_FUNC_TABLE(scm_new_srfi34_func_info_table);
+
+    current_exception_handlers = LIST_1(proc_fallback_handler);
+}
+
+static ScmObj set_cur_handlers(ScmObj handlers, ScmObj env)
+{
+    DECLARE_PRIVATE_FUNCTION("with_exception_handlers", SyntaxFixed1);
+
+    current_exception_handlers = handlers;
+    return SCM_UNDEF;
+}
+
+static ScmObj with_exception_handlers(ScmObj new_handlers, ScmObj thunk)
+{
+    ScmObj prev_handlers, before, after;
+    DECLARE_PRIVATE_FUNCTION("with_exception_handlers", ProcedureFixed2);
+
+    prev_handlers = current_exception_handlers;
+    before = ScmExp_lambda(SCM_NULL,
+                           LIST_1(LIST_2(syn_set_cur_handlers, new_handlers)),
+                           SCM_INTERACTION_ENV);
+    after = ScmExp_lambda(SCM_NULL,
+                          LIST_1(LIST_2(syn_set_cur_handlers, prev_handlers)),
+                          SCM_INTERACTION_ENV);
+    return ScmOp_dynamic_wind(before, thunk, after);
+}
+
+/* with-exception-handler */
+
+ScmObj ScmOp_SRFI34_with_exception_handler(ScmObj handler, ScmObj thunk)
+{
+    ScmObj handlers;
+    DECLARE_FUNCTION("with-exception-handler", ProcedureFixed2);
+
+    ASSERT_PROCEDUREP(handler);
+    ASSERT_PROCEDUREP(thunk);
+
+    handlers = CONS(handler, current_exception_handlers);
+    return with_exception_handlers(handlers, thunk);
+}
+
+/* raise */
+
+ScmObj ScmOp_SRFI34_raise(ScmObj obj)
+{
+    ScmObj handler, rest_handlers, thunk;
+    DECLARE_FUNCTION("raise", ProcedureFixed1);
+
+    handler = CAR(current_exception_handlers);
+    rest_handlers = CDR(current_exception_handlers);
+    thunk = ScmExp_lambda(SCM_NULL,
+                          LIST_2(LIST_2(handler, obj),
+                                 LIST_3(sym_error,
+                                        errmsg_handler_returned, obj)),
+                          SCM_INTERACTION_ENV);
+    return with_exception_handlers(rest_handlers, thunk);
+}
+
+/* guard */
+
+ScmObj ScmExp_SRFI34_guard(ScmObj cond_catch, ScmObj body,
+                           ScmEvalState *eval_state)
+{
+    ScmObj lex_env, proc_guard_int, ret;
+    DECLARE_FUNCTION("guard", SyntaxVariadicTailRec1);
+
+    ASSERT_CONSP(cond_catch);
+    ASSERT_CONSP(body);
+
+    lex_env = eval_state->env;
+    eval_state->env
+        = Scm_ExtendEnvironment(LIST_3(sym_lex_env, sym_cond_catch, sym_body),
+                                LIST_3(lex_env, cond_catch, body),
+                                lex_env);
+    proc_guard_int = ScmExp_lambda(LIST_1(sym_guard_k),
+                                   LIST_1(LIST_2(syn_guard_internal, sym_guard_k)),
+                                   eval_state->env);
+    
+    ret = Scm_CallWithCurrentContinuation(proc_guard_int, eval_state);
+    eval_state->env      = lex_env;
+    eval_state->ret_type = SCM_RETTYPE_AS_IS;
+    return Scm_call(ret, SCM_NULL);
+}
+
+static ScmObj guard_internal(ScmObj q_guard_k, ScmObj env)
+{
+    ScmObj handler, body;
+    DECLARE_PRIVATE_FUNCTION("guard", SyntaxFixed1);
+
+    handler = ScmExp_lambda(LIST_1(sym_condition),
+                            LIST_1(LIST_2(syn_guard_handler, sym_condition)),
+                            env);
+    body = ScmExp_lambda(SCM_NULL,
+                         LIST_1(LIST_1(syn_guard_body)),
+                         env);
+
+    return ScmOp_SRFI34_with_exception_handler(handler, body);
+}
+
+static ScmObj guard_handler(ScmObj q_condition, ScmEvalState *eval_state)
+{
+    ScmObj handler_body, ret;
+    DECLARE_PRIVATE_FUNCTION("guard", SyntaxFixedTailRec1);
+
+    handler_body
+        = ScmExp_lambda(LIST_1(sym_handler_k),
+                        LIST_1(LIST_2(syn_guard_handler_body, sym_handler_k)),
+                        eval_state->env);
+    ret = Scm_CallWithCurrentContinuation(handler_body, eval_state);
+    if (eval_state->ret_type == SCM_RETTYPE_NEED_EVAL) {
+        ret = EVAL(ret, eval_state->env);
+        eval_state->ret_type = SCM_RETTYPE_AS_IS;
+    }
+    return Scm_call(ret, SCM_NULL);
+}
+
+/* assumes that ScmExp_delay() returns a closure */
+static ScmObj guard_handler_body(ScmObj handler_k, ScmObj env)
+{
+    ScmEvalState eval_state;
+    ScmObj lex_env, cond_env, condition, cond_catch, guard_k;
+    ScmObj sym_var, clauses, caught, reraise, ret;
+    DECLARE_PRIVATE_FUNCTION("guard", SyntaxFixed1);
+
+    lex_env    = Scm_SymbolValue(sym_lex_env, env);
+    condition  = Scm_SymbolValue(sym_condition, env);
+    cond_catch = Scm_SymbolValue(sym_cond_catch, env);
+    guard_k    = Scm_SymbolValue(sym_guard_k, env);
+
+    /* eval cond-catch block */
+    sym_var = CAR(cond_catch);
+    clauses = CDR(cond_catch);
+    ASSERT_SYMBOLP(sym_var);
+    condition = EVAL(condition, lex_env);
+    cond_env = Scm_ExtendEnvironment(LIST_1(sym_var),
+                                     LIST_1(condition),
+                                     lex_env);
+    eval_state.env = cond_env;
+    eval_state.ret_type = SCM_RETTYPE_NEED_EVAL;
+    caught = ScmExp_cond_internal(clauses, &eval_state);
+
+    if (VALIDP(caught)) {
+        if (eval_state.ret_type == SCM_RETTYPE_NEED_EVAL)
+            caught = EVAL(caught, cond_env);
+        ret = ScmExp_delay(LIST_2(SYM_QUOTE, caught), cond_env);
+        Scm_CallContinuation(guard_k, ret);
+    } else {
+        reraise = ScmExp_delay(LIST_2(sym_raise, LIST_2(SYM_QUOTE, condition)),
+                               cond_env);
+        Scm_CallContinuation(handler_k, reraise);
+    }
+    /* NOTREACHED */
+    return SCM_UNDEF;
+}
+
+/* assumes that ScmExp_delay() returns a closure */
+static ScmObj guard_body(ScmEvalState *eval_state)
+{
+    ScmEvalState lex_eval_state;
+    ScmObj lex_env, guard_k, body, result, vals, ret;
+    DECLARE_PRIVATE_FUNCTION("guard", SyntaxFixedTailRec0);
+
+    lex_env = Scm_SymbolValue(sym_lex_env, eval_state->env);
+    guard_k = Scm_SymbolValue(sym_guard_k, eval_state->env);
+    body    = Scm_SymbolValue(sym_body,    eval_state->env);
+
+    /* evaluate the body */
+    lex_eval_state.env      = lex_env;
+    lex_eval_state.ret_type = SCM_RETTYPE_NEED_EVAL;
+    result = ScmExp_begin(body, &lex_eval_state);  /* always NEED_EVAL */
+    result = EVAL(result, lex_env);
+    eval_state->ret_type = SCM_RETTYPE_AS_IS;
+
+    if (VALUEPACKETP(result)) {
+        vals = SCM_VALUEPACKET_VALUES(result);
+        ret = ScmExp_delay(LIST_3(syn_apply,
+                                  proc_values, LIST_2(SYM_QUOTE, vals)),
+                           lex_env);
+    } else {
+        ret = ScmExp_delay(LIST_2(SYM_QUOTE, result), lex_env);
+    }
+    Scm_CallContinuation(guard_k, ret);
+    /* NOTREACHED */
+    return SCM_UNDEF;
+}

Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2005-11-13 14:32:38 UTC (rev 2125)
+++ branches/r5rs/sigscheme/operations.c	2005-11-13 15:29:51 UTC (rev 2126)
@@ -1792,8 +1792,13 @@
 #include "operations-srfi23.c"
 #endif
 #if SCM_USE_SRFI34
+#if SCM_USE_FORMER_SRFI34
 #include "operations-srfi34.c"
 #endif
+#if SCM_USE_NEW_SRFI34
+#include "operations-new-srfi34.c"
+#endif
+#endif /* SCM_USE_SRFI34 */
 #if SCM_USE_SRFI38
 #include "operations-srfi38.c"
 #endif

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-11-13 14:32:38 UTC (rev 2125)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-11-13 15:29:51 UTC (rev 2126)
@@ -714,7 +714,12 @@
 /* operations-srfi34.c */
 void  SigScm_Initialize_SRFI34(void);
 ScmObj ScmOp_SRFI34_with_exception_handler(ScmObj handler, ScmObj thunk);
+#if SCM_USE_NEW_SRFI34
+ScmObj ScmExp_SRFI34_guard(ScmObj cond_catch, ScmObj body,
+                           ScmEvalState *eval_state);
+#else /* SCM_USE_NEW_SRFI34 */
 ScmObj ScmExp_SRFI34_guard(ScmObj var_and_clauses, ScmObj body, ScmObj env);
+#endif /* SCM_USE_NEW_SRFI34 */
 ScmObj ScmOp_SRFI34_raise(ScmObj obj);
 #endif
 #if SCM_USE_SRFI38

Modified: branches/r5rs/sigscheme/sigschemefunctable.c
===================================================================
--- branches/r5rs/sigscheme/sigschemefunctable.c	2005-11-13 14:32:38 UTC (rev 2125)
+++ branches/r5rs/sigscheme/sigschemefunctable.c	2005-11-13 15:29:51 UTC (rev 2126)
@@ -76,9 +76,12 @@
 #if SCM_USE_SRFI23
 #include "sigschemefunctable-srfi23.c"
 #endif
-#if SCM_USE_SRFI34
+#if SCM_USE_FORMER_SRFI34
 #include "sigschemefunctable-srfi34.c"
 #endif
+#if SCM_USE_NEW_SRFI34
+#include "sigschemefunctable-new-srfi34.c"
+#endif
 #if SCM_USE_SRFI38
 #include "sigschemefunctable-srfi38.c"
 #endif

Modified: branches/r5rs/sigscheme/sigschemefunctable.h
===================================================================
--- branches/r5rs/sigscheme/sigschemefunctable.h	2005-11-13 14:32:38 UTC (rev 2125)
+++ branches/r5rs/sigscheme/sigschemefunctable.h	2005-11-13 15:29:51 UTC (rev 2126)
@@ -91,9 +91,12 @@
 #if SCM_USE_SRFI23
 extern struct builtin_func_info srfi23_func_info_table[];
 #endif
-#if SCM_USE_SRFI34
+#if SCM_USE_FORMER_SRFI34
 extern struct builtin_func_info srfi34_func_info_table[];
 #endif
+#if SCM_USE_NEW_SRFI34
+extern struct builtin_func_info scm_new_srfi34_func_info_table[];
+#endif
 #if SCM_USE_SRFI38
 extern struct builtin_func_info srfi38_func_info_table[];
 #endif

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2005-11-13 14:32:38 UTC (rev 2125)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2005-11-13 15:29:51 UTC (rev 2126)
@@ -298,7 +298,7 @@
 #define ASSERT_PROCEDUREP(obj) ASSERT_TYPE(PROCEDUREP, "procedure", (obj))
 #define ASSERT_ENVP(obj)     ASSERT_TYPE(ENVP, "environment specifier", (obj))
 
-#if SCM_USE_SRFI34
+#if SCM_USE_FORMER_SRFI34
 /* Macros and Variables For Handling Exception Handlers based on SRFI-34 */
 extern ScmObj scm_exception_handlers;
 extern ScmObj scm_exception_continuations;
@@ -317,7 +317,7 @@
     (scm_exception_continuations = CONS((cont), scm_exception_continuations))
 #define POP_EXCEPTION_CONTINUATION()            \
     (scm_exception_continuations = CDR(scm_exception_continuations))
-#endif /* SCM_USE_SRFI34 */
+#endif /* SCM_USE_FORMER_SRFI34 */
 
 /* Macros For Handling Continuation Object */
 #define INVALID_CONTINUATION_OPAQUE  NULL



More information about the uim-commit mailing list