[uim-commit] r2145 - branches/r5rs/sigscheme
yamaken at freedesktop.org
yamaken at freedesktop.org
Mon Nov 14 12:50:55 PST 2005
Author: yamaken
Date: 2005-11-14 12:50:51 -0800 (Mon, 14 Nov 2005)
New Revision: 2145
Removed:
branches/r5rs/sigscheme/operations-srfi34.c
Modified:
branches/r5rs/sigscheme/Makefile.am
branches/r5rs/sigscheme/config.h
branches/r5rs/sigscheme/error.c
branches/r5rs/sigscheme/main.c
branches/r5rs/sigscheme/operations-srfi23.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemefunctable.c
branches/r5rs/sigscheme/sigschemefunctable.h
branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* This commit removes the obsoleted SRFI-34 implementation
* sigscheme/config.h
- (SCM_USE_FORMER_SRFI34, SCM_USE_NEW_SRFI34): Removed
* sigscheme/sigscheme.h
- (ScmExp_SRFI34_guard): Removed the SCM_USE_FORMER_SRFI34 version
* sigscheme/sigschemeinternal.h
- (scm_exception_handlers, scm_exception_continuations): Removed
- (CURRENT_EXCEPTION_HANDLER, PUSH_EXCEPTION_HANDLER,
POP_EXCEPTION_HANDLER, CURRENT_EXCEPTION_CONTINUATION,
PUSH_EXCEPTION_CONTINUATION, POP_EXCEPTION_CONTINUATION): Removed
* sigscheme/operations-srfi34.c
- Removed file
- (CONTINUATION_FRAME, CONTINUATION_SET_FRAME, CONTINUATION_JMPENV,
CONTINUATION_SET_JMPENV, CONTINUATION_DYNEXT,
CONTINUATION_SET_DYNEXT, struct continuation_frame,
scm_exception_handlers, scm_exception_continuations,
exception_thrown_obj, guard_handle_clauses,
SigScm_Initialize_SRFI34, ScmOp_SRFI34_with_exception_handler,
ScmExp_SRFI34_guard, ScmOp_SRFI34_raise): Removed
* sigscheme/operations-srfi23.c
- (ScmOp_SRFI23_error): Remove SCM_USE_FORMER_SRFI34 support
* sigscheme/error.c
- (Scm_ThrowException): Removed
- (SigScm_Die, SigScm_Error, SigScm_ErrorObj, Scm_ErrorObj): Remove
SCM_USE_FORMER_SRFI34 support
* sigscheme/main.c
- (repl_loop): Remove SCM_USE_FORMER_SRFI34 support
* sigscheme/sigschemefunctable.h
* sigscheme/sigschemefunctable.c
* sigscheme/operations.c
- Remove SCM_USE_FORMER_SRFI34 support
* sigscheme/Makefile.am
- (FUNC_TABLES): Remove sigschemefunctable-srfi34.c
- Remove the generation rule for sigschemefunctable-srfi34.c
* sigscheme/sigscheme.c
- (SigScm_Initialize_internal): Resurrect the 'else => #t binding
always. At least 'case' syntax is still depending on this
Modified: branches/r5rs/sigscheme/Makefile.am
===================================================================
--- branches/r5rs/sigscheme/Makefile.am 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/Makefile.am 2005-11-14 20:50:51 UTC (rev 2145)
@@ -13,7 +13,6 @@
sigschemefunctable-srfi6.c \
sigschemefunctable-srfi8.c \
sigschemefunctable-srfi23.c \
- sigschemefunctable-srfi34.c \
sigschemefunctable-new-srfi34.c \
sigschemefunctable-srfi38.c \
sigschemefunctable-srfi60.c
@@ -46,9 +45,6 @@
sigschemefunctable-srfi23.c: ./script/build_func_table.rb operations-srfi23.c
./script/build_func_table.rb "_SRFI23_" "srfi23_func_info_table" "operations-srfi23.c" \
> sigschemefunctable-srfi23.c
-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
Modified: branches/r5rs/sigscheme/config.h
===================================================================
--- branches/r5rs/sigscheme/config.h 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/config.h 2005-11-14 20:50:51 UTC (rev 2145)
@@ -46,8 +46,6 @@
#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 0 /* use former SRFI-34 implementation */
-#define SCM_USE_NEW_SRFI34 1 /* 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 */
@@ -132,12 +130,10 @@
#define SCM_USE_SRFI34 1
#endif /* SCM_EXCEPTION_HANDLING */
-#if SCM_USE_NEW_SRFI34
-#undef SCM_FORMER_SRFI34
-#undef SCM_EXCEPTION_HANDLING
+#if SCM_USE_SRFI34
#undef SCM_USE_SRFI23
#define SCM_USE_SRFI23 1
-#endif /* SCM_USE_NEW_SRFI34 */
+#endif /* SCM_USE_SRFI34 */
#if SCM_DEBUG
#undef SCM_VOLATILE_OUTPUT
Modified: branches/r5rs/sigscheme/error.c
===================================================================
--- branches/r5rs/sigscheme/error.c 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/error.c 2005-11-14 20:50:51 UTC (rev 2145)
@@ -198,32 +198,8 @@
return SCM_UNDEF;
}
-#if SCM_USE_FORMER_SRFI34
-void Scm_ThrowException(ScmObj errorobj)
-{
-#if SCM_EXCEPTION_HANDLING
- if (FALSEP(CURRENT_EXCEPTION_CONTINUATION())) {
- /* outermost exception handler */
- if (SigScm_DebugCategories() & SCM_DBG_BACKTRACE)
- SigScm_ShowBacktrace(Scm_TraceStack());
-
- exit(EXIT_FAILURE);
- } else {
- /* throw an exception */
- ScmOp_SRFI34_raise(errorobj);
- }
-#else
- if (SigScm_DebugCategories() & SCM_DBG_BACKTRACE)
- SigScm_ShowBacktrace(Scm_TraceStack());
-#endif
-
- exit(EXIT_FAILURE);
-}
-#endif /* SCM_USE_FORMER_SRFI34 */
-
int SigScm_Die(const char *msg, const char *filename, int line)
{
-#if SCM_USE_NEW_SRFI34
char *reason;
ScmObj err_obj;
@@ -236,18 +212,6 @@
#endif /* HAVE_ASPRINTF */
err_obj = Scm_MakeErrorObj(Scm_NewString(reason), LIST_1(SCM_UNDEF));
ScmOp_sscm_fatal_error(err_obj);
-#else /* SCM_USE_NEW_SRFI34 */
- if (SigScm_DebugCategories() & SCM_DBG_ERRMSG) {
- SigScm_ShowErrorHeader();
- SigScm_ErrorPrintf("SigScheme Died : %s (file : %s, line : %d)\n",
- msg, filename, line);
- }
-
- if (SigScm_DebugCategories() & SCM_DBG_BACKTRACE)
- SigScm_ShowBacktrace(Scm_TraceStack());
-
- exit(EXIT_FAILURE);
-#endif /* SCM_USE_NEW_SRFI34 */
/* NOTREACHED */
return 1; /* dummy value for boolean expression */
}
@@ -255,8 +219,6 @@
void SigScm_Error(const char *msg, ...)
{
va_list va;
-
-#if SCM_USE_NEW_SRFI34
char *reason;
ScmObj err_obj;
@@ -269,48 +231,21 @@
err_obj = Scm_MakeErrorObj(Scm_NewString(reason), LIST_1(SCM_UNDEF));
Scm_RaiseError(err_obj);
/* NOTREACHED */
-#else /* SCM_USE_NEW_SRFI34 */
- if (SigScm_DebugCategories() & SCM_DBG_ERRMSG) {
- SigScm_ShowErrorHeader();
-
- va_start(va, msg);
- SigScm_VErrorPrintf(msg, va);
- va_end(va);
-
- SigScm_ErrorNewline();
- }
-
- /* FIXME: this errorobj is OK? */
- Scm_ThrowException(Scm_NewStringCopying("ERROR"));
-#endif /* SCM_USE_NEW_SRFI34 */
}
/* Obsolete. */
void SigScm_ErrorObj(const char *msg, ScmObj obj)
{
-#if SCM_USE_NEW_SRFI34
ScmObj err_obj;
err_obj = Scm_MakeErrorObj(Scm_NewStringCopying(msg), LIST_1(obj));
Scm_RaiseError(err_obj);
/* NOTREACHED */
-#else /* SCM_USE_NEW_SRFI34 */
- if (SigScm_DebugCategories() & SCM_DBG_ERRMSG) {
- SigScm_ShowErrorHeader();
- SigScm_ErrorPrintf(msg);
- SigScm_WriteToPort(scm_current_error_port, obj);
- SigScm_ErrorNewline();
- }
-
- /* FIXME: this errorobj is OK? */
- Scm_ThrowException(Scm_NewStringCopying("ERROR"));
-#endif /* SCM_USE_NEW_SRFI34 */
}
/* This function obsoletes SigScm_ErrorObj(). */
void Scm_ErrorObj(const char *func_name, const char *msg, ScmObj obj)
{
-#if SCM_USE_NEW_SRFI34
char *reason;
ScmObj err_obj;
@@ -323,17 +258,6 @@
err_obj = Scm_MakeErrorObj(Scm_NewString(reason), LIST_1(obj));
Scm_RaiseError(err_obj);
/* NOTREACHED */
-#else /* SCM_USE_NEW_SRFI34 */
- if (SigScm_DebugCategories() & SCM_DBG_ERRMSG) {
- SigScm_ShowErrorHeader();
- SigScm_ErrorPrintf("in %s: %s: ", func_name, msg);
- SigScm_WriteToPort(scm_current_error_port, obj);
- SigScm_ErrorNewline();
- }
-
- /* FIXME: this errorobj is OK? */
- Scm_ThrowException(Scm_NewStringCopying("ERROR"));
-#endif /* SCM_USE_NEW_SRFI34 */
}
void SigScm_ShowBacktrace(ScmObj trace_stack)
Modified: branches/r5rs/sigscheme/main.c
===================================================================
--- branches/r5rs/sigscheme/main.c 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/main.c 2005-11-14 20:50:51 UTC (rev 2145)
@@ -95,19 +95,20 @@
ScmObj cond_catch = SCM_FALSE;
int is_prompt = is_repl_prompt();
+#if SCM_USE_SRFI34
/* prepare the constant part of the form to get the loop fast */
sym_guard = Scm_Intern("guard");
cond_catch = LIST_2(Scm_Intern("err"),
LIST_2(SYM_ELSE,
LIST_2(Scm_Intern("%%inspect-error"),
Scm_Intern("err"))));
+#endif /* SCM_USE_SRFI34 */
if (is_prompt)
SigScm_PortPrintf(scm_current_output_port, PROMPT_STR);
while (s_exp = SigScm_Read(scm_current_input_port), !EOFP(s_exp)) {
#if SCM_USE_SRFI34
-#if SCM_USE_NEW_SRFI34
/*
* Error-proof evaluation
*
@@ -121,23 +122,9 @@
*/
result = EVAL(LIST_3(sym_guard, cond_catch, s_exp),
SCM_INTERACTION_ENV);
-#else /* SCM_USE_NEW_SRFI34 */
- /*
- * Error Aware repl_loop
- *
- * (guard (err (else #f))
- * (eval exp '()))
- */
- result = ScmExp_SRFI34_guard(LIST_2(Scm_Intern("err"),
- LIST_2(Scm_Intern("else"), SCM_UNDEF)),
- LIST_1(LIST_3(Scm_Intern("eval"),
- 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
+#endif /* SCM_USE_SRFI34 */
#if SCM_USE_SRFI38
SigScm_WriteToPortWithSharedStructure(scm_current_output_port, result);
Modified: branches/r5rs/sigscheme/operations-srfi23.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi23.c 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/operations-srfi23.c 2005-11-14 20:50:51 UTC (rev 2145)
@@ -34,7 +34,6 @@
/*=======================================
System Include
=======================================*/
-#include <stdlib.h>
/*=======================================
Local Include
@@ -72,8 +71,6 @@
/*=============================================================================
SRFI23 : Error reporting mechanism
=============================================================================*/
-#if SCM_USE_NEW_SRFI34
-
/*
* This code implements the '4.' of following Specification defined in SRFI-34.
*
@@ -104,36 +101,3 @@
/* NOTREACHED */
return SCM_UNDEF;
}
-
-#else /* SCM_USE_NEW_SRFI34 */
-
-ScmObj ScmOp_SRFI23_error(ScmObj reason, ScmObj args)
-{
- ScmObj arg = SCM_FALSE;
- DECLARE_FUNCTION("error", ProcedureVariadic1);
-
- ASSERT_STRINGP(reason);
-
- if (SigScm_DebugCategories() & SCM_DBG_ERRMSG) {
- SigScm_ShowErrorHeader();
- SigScm_DisplayToPort(scm_current_error_port, reason);
-
- /* show each obj */
- for (; !NULLP(args); args = CDR(args)) {
- arg = CAR(args);
- SigScm_ErrorPrintf(" ");
-#if SCM_USE_SRFI38
- SigScm_WriteToPortWithSharedStructure(scm_current_error_port, arg);
-#else
- SigScm_WriteToPort(scm_current_error_port, arg);
-#endif
- }
-
- SigScm_ErrorNewline();
- }
-
- Scm_ThrowException(args);
- /* NOTREACHED */
- return SCM_UNDEF;
-}
-#endif /* SCM_USE_NEW_SRFI34 */
Deleted: branches/r5rs/sigscheme/operations-srfi34.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi34.c 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/operations-srfi34.c 2005-11-14 20:50:51 UTC (rev 2145)
@@ -1,265 +0,0 @@
-/*===========================================================================
- * FileName : operations-srfi34.c
- * About : Exception Handling for Programs
- *
- * Copyright (C) 2005 by Kazuki Ohta (mover at hct.zaq.ne.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.
-===========================================================================*/
-
-/*=======================================
- System Include
-=======================================*/
-#include <setjmp.h>
-
-/*=======================================
- Local Include
-=======================================*/
-#include "sigscheme.h"
-#include "sigschemeinternal.h"
-
-/*=======================================
- File Local Macro Declarations
-=======================================*/
-/* FIXME: make internal representation hidden */
-#define CONTINUATION_FRAME(cont) \
- ((struct continuation_frame *)SCM_CONTINUATION_OPAQUE(cont))
-#define CONTINUATION_SET_FRAME SCM_CONTINUATION_SET_OPAQUE
-#define CONTINUATION_JMPENV(cont) (CONTINUATION_FRAME(cont)->env)
-#define CONTINUATION_SET_JMPENV(cont, env) (CONTINUATION_JMPENV(cont) = (env))
-#define CONTINUATION_DYNEXT(cont) (CONTINUATION_FRAME(cont)->dyn_ext)
-#define CONTINUATION_SET_DYNEXT(cont, dyn_ext) \
- ((CONTINUATION_DYNEXT(cont)) = (dyn_ext))
-
-/*=======================================
- File Local Type Definitions
-=======================================*/
-/* FIXME: make internal representation hidden */
-struct continuation_frame {
- jmp_buf *env;
- ScmObj dyn_ext;
-};
-
-/*=======================================
- Variable Declarations
-=======================================*/
-/* storage-continuation.c */
-extern ScmObj scm_current_dynamic_extent;
-
-ScmObj scm_exception_handlers = NULL;
-ScmObj scm_exception_continuations = NULL;
-
-static ScmObj exception_thrown_obj = NULL;
-
-/*=======================================
- File Local Function Declarations
-=======================================*/
-static ScmObj guard_handle_clauses(ScmObj clauses, ScmObj env);
-
-/*=======================================
- Function Implementations
-=======================================*/
-void SigScm_Initialize_SRFI34(void)
-{
- /*=======================================================================
- SRFI-34 Procedure
- =======================================================================*/
- REGISTER_FUNC_TABLE(srfi34_func_info_table);
-
- scm_exception_handlers = SCM_FALSE;
- scm_exception_continuations = SCM_FALSE;
- SigScm_GC_Protect(&scm_exception_handlers);
- SigScm_GC_Protect(&scm_exception_continuations);
-}
-
-/*
- * FIXME: Reimplement with dynamic-wind as "Reference Implementation" of
- * SRFI-34 does, without direct use of setjmp/longjmp
- */
-ScmObj ScmOp_SRFI34_with_exception_handler(ScmObj handler, ScmObj thunk)
-{
- jmp_buf jmpenv;
- ScmObj ret = SCM_FALSE;
- ScmObj cont = Scm_NewContinuation();
- struct continuation_frame cont_frame;
- DECLARE_FUNCTION("with-exception-handler", ProcedureFixed2);
-
- ASSERT_PROCEDUREP(handler);
- ASSERT_PROCEDUREP(thunk);
-
- CONTINUATION_SET_FRAME(cont, &cont_frame);
- CONTINUATION_SET_JMPENV(cont, &jmpenv);
- CONTINUATION_SET_DYNEXT(cont, scm_current_dynamic_extent);
- if (setjmp(jmpenv)) {
- ret = Scm_call(CURRENT_EXCEPTION_HANDLER(), LIST_1(exception_thrown_obj));
- POP_EXCEPTION_CONTINUATION();
- POP_EXCEPTION_HANDLER();
- exception_thrown_obj = SCM_FALSE; /* make sweepable */
- return ret;
- }
-
- PUSH_EXCEPTION_HANDLER(handler);
- PUSH_EXCEPTION_CONTINUATION(cont);
- ret = Scm_call(thunk, SCM_NULL);
- POP_EXCEPTION_CONTINUATION();
- POP_EXCEPTION_HANDLER();
-
- return ret;
-}
-
-/*
- * FIXME: Reimplement with dynamic-wind, Scm_CallWithCurrentContinuation() and
- * Scm_CallContinuation() as "Reference Implementation" of SRFI-34 does,
- * without direct use of setjmp/longjmp
- */
-ScmObj ScmExp_SRFI34_guard(ScmObj var_and_clauses, ScmObj body, ScmObj env)
-{
- /* (guard (var clauses) body) */
- jmp_buf jmpenv;
- ScmObj var = SCM_FALSE;
- ScmObj clauses = SCM_FALSE;
- ScmObj expr = SCM_FALSE;
- ScmObj cont = Scm_NewContinuation();
- struct continuation_frame cont_frame;
- DECLARE_FUNCTION("guard", SyntaxVariadic1);
-
- ASSERT_CONSP(var_and_clauses);
-
- var = CAR(var_and_clauses);
- clauses = CDR(var_and_clauses);
-
- ASSERT_SYMBOLP(var);
-
- /* check if return from "raise" */
- CONTINUATION_SET_FRAME(cont, &cont_frame);
- CONTINUATION_SET_JMPENV(cont, &jmpenv);
- CONTINUATION_SET_DYNEXT(cont, scm_current_dynamic_extent);
- if (setjmp(jmpenv)) {
- POP_EXCEPTION_CONTINUATION();
- env = Scm_ExtendEnvironment(LIST_1(var), LIST_1(exception_thrown_obj), env);
- return guard_handle_clauses(clauses, env);
- }
-
- PUSH_EXCEPTION_CONTINUATION(cont);
- while (!NO_MORE_ARG(body)) {
- expr = POP_ARG(body);
- expr = EVAL(expr, env);
- }
- POP_EXCEPTION_CONTINUATION();
-
- return expr;
-}
-
-/* FIXME:
- * - Simplify with ScmExp_cond()
- */
-static ScmObj guard_handle_clauses(ScmObj clauses, ScmObj env)
-{
- ScmObj thrown = exception_thrown_obj;
- ScmObj clause = SCM_FALSE;
- ScmObj test = SCM_FALSE;
- ScmObj exps = SCM_FALSE;
- ScmObj proc = SCM_FALSE;
- ScmObj ret = SCM_FALSE;
- DECLARE_INTERNAL_FUNCTION("guard");
-
- /* make sweepable */
- exception_thrown_obj = SCM_FALSE;
-
- /* handle "cond" like clause */
- for (; !NULLP(clauses); clauses = CDR(clauses)) {
- clause = CAR(clauses);
- if (!CONSP(clause))
- ERR_OBJ("bad clause", clause);
-
- test = CAR(clause);
- exps = CDR(clause);
-
- /* evaluate test */
- test = EVAL(test, env);
-
- if (NFALSEP(test)) {
- /*
- * if the selected <clause> contains only the <test> and no <expression>s,
- * then the value of the <test> is returned as the result.
- */
- if (NULLP(exps))
- return test;
-
- /*
- * If the selected <clause> uses the => alternate form, then the <expression>
- * is evaluated. Its value must be a procedure that accepts one argument;
- * this procedure is then called on the value of the <test> and the value
- * returned by this procedure is returned by the guard expression.
- */
- /* FIXME: remove expensive Scm_Intern() */
- if (EQ(Scm_Intern("=>"), CAR(exps))) {
- proc = EVAL(CADR(exps), env);
- if (FALSEP(ScmOp_procedurep(proc)))
- ERR_OBJ("the value of exp after => must be the procedure but got", proc);
-
- return Scm_call(proc, LIST_1(test));
- }
-
- for (; !NULLP(exps); exps = CDR(exps))
- ret = EVAL(CAR(exps), env);
-
- return ret;
- }
- }
-
- /* "reraise" exception */
- if (NULLP(CURRENT_EXCEPTION_CONTINUATION()))
- ERR("guard: cannot reraise exception");
- ScmOp_SRFI34_raise(thrown);
-
- /* never reaches here */
- return SCM_UNDEF;
-}
-
-/*
- * FIXME:
- * - Reimplement with dynamic-wind as "Reference Implementation" of SRFI-34
- * does, without direct use of setjmp/longjmp
- * - Cause error when the current exception handler returns, as "Reference
- * Implementation" of SRFI-34 does. current implementation allows writing
- * unspecified behavior
- */
-ScmObj ScmOp_SRFI34_raise(ScmObj obj)
-{
- jmp_buf *env;
- DECLARE_FUNCTION("raise", ProcedureFixed1);
-
- exception_thrown_obj = obj;
-
- env = CONTINUATION_JMPENV(CURRENT_EXCEPTION_CONTINUATION());
- longjmp(*env, 1);
-
- /* never reaches here */
- return SCM_UNDEF;
-}
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/operations.c 2005-11-14 20:50:51 UTC (rev 2145)
@@ -1792,13 +1792,8 @@
#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.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-11-14 20:50:51 UTC (rev 2145)
@@ -146,7 +146,7 @@
Scm_sym_unquote_splicing = Scm_Intern("unquote-splicing");
Scm_sym_else = Scm_Intern("else");
Scm_sym_yields = Scm_Intern("=>");
-#if SCM_USE_FORMER_SRFI34
+#if 1
/* FIXME: obsolete this. don't set SCM_TRUE and rely on the value */
SCM_SYMBOL_SET_VCELL(Scm_Intern("else"), SCM_TRUE);
#endif
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-11-14 20:50:51 UTC (rev 2145)
@@ -720,12 +720,8 @@
/* 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-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/sigschemefunctable.c 2005-11-14 20:50:51 UTC (rev 2145)
@@ -77,10 +77,7 @@
#if SCM_USE_SRFI23
#include "sigschemefunctable-srfi23.c"
#endif
-#if SCM_USE_FORMER_SRFI34
-#include "sigschemefunctable-srfi34.c"
-#endif
-#if SCM_USE_NEW_SRFI34
+#if SCM_USE_SRFI34
#include "sigschemefunctable-new-srfi34.c"
#endif
#if SCM_USE_SRFI38
Modified: branches/r5rs/sigscheme/sigschemefunctable.h
===================================================================
--- branches/r5rs/sigscheme/sigschemefunctable.h 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/sigschemefunctable.h 2005-11-14 20:50:51 UTC (rev 2145)
@@ -94,10 +94,7 @@
#if SCM_USE_SRFI23
extern struct builtin_func_info srfi23_func_info_table[];
#endif
-#if SCM_USE_FORMER_SRFI34
-extern struct builtin_func_info srfi34_func_info_table[];
-#endif
-#if SCM_USE_NEW_SRFI34
+#if SCM_USE_SRFI34
extern struct builtin_func_info scm_new_srfi34_func_info_table[];
#endif
#if SCM_USE_SRFI38
Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2005-11-14 20:16:01 UTC (rev 2144)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2005-11-14 20:50:51 UTC (rev 2145)
@@ -300,27 +300,6 @@
#define ASSERT_ENVP(obj) ASSERT_TYPE(ENVP, "environment specifier", (obj))
#define ASSERT_ERROBJP(obj) ASSERT_TYPE(ERROBJP, "error object", (obj))
-#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;
-
-#define CURRENT_EXCEPTION_HANDLER() \
- (FALSEP(scm_exception_handlers) \
- ? scm_exception_handlers : CAR(scm_exception_handlers))
-#define PUSH_EXCEPTION_HANDLER(handler) \
- (scm_exception_handlers = CONS((handler), scm_exception_handlers))
-#define POP_EXCEPTION_HANDLER() \
- (scm_exception_handlers = CDR(scm_exception_handlers))
-
-#define CURRENT_EXCEPTION_CONTINUATION() \
- (FALSEP(scm_exception_continuations) ? scm_exception_continuations : CAR(scm_exception_continuations))
-#define PUSH_EXCEPTION_CONTINUATION(cont) \
- (scm_exception_continuations = CONS((cont), scm_exception_continuations))
-#define POP_EXCEPTION_CONTINUATION() \
- (scm_exception_continuations = CDR(scm_exception_continuations))
-#endif /* SCM_USE_FORMER_SRFI34 */
-
/* Macros For Handling Continuation Object */
#define INVALID_CONTINUATION_OPAQUE NULL
More information about the uim-commit
mailing list