[uim-commit] r1371 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Wed Aug 31 16:11:38 PDT 2005
Author: kzk
Date: 2005-08-31 16:11:35 -0700 (Wed, 31 Aug 2005)
New Revision: 1371
Added:
branches/r5rs/sigscheme/operations-srfi23.c
Modified:
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
Log:
* implement SRFI-23 "Error reporting mechanism" feature
* sigscheme/sigscheme.c
- (SigScm_Initialize): export "error"
* sigscheme/sigscheme.h
- (SCM_USE_SRFI23): new flag
- (ScmOp_SRFI23_errro): new func
* sigscheme/operations.c
- #include "operations-srfi23.c" when SCM_USE_SRFI23 is enabled
* sigscheme/operations-srfi23.c
- (ScmOp_SRFI23_error): new func. I wonder whether this function
calls exit or not. please comment if you feel that exiting here
is bad.
Added: branches/r5rs/sigscheme/operations-srfi23.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi23.c 2005-08-31 22:34:23 UTC (rev 1370)
+++ branches/r5rs/sigscheme/operations-srfi23.c 2005-08-31 23:11:35 UTC (rev 1371)
@@ -0,0 +1,101 @@
+/*===========================================================================
+ * FileName : operations-srfi23.c
+ * About : srfi23 Error reporting mechanism
+ *
+ * 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
+=======================================*/
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+
+/*=======================================
+ File Local Struct Declarations
+=======================================*/
+
+/*=======================================
+ File Local Macro Declarations
+=======================================*/
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+extern ScmObj scm_current_error_port;
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+
+/*=======================================
+ Function Implementations
+=======================================*/
+/*=============================================================================
+ SRFI23 : Error reporting mechanism
+=============================================================================*/
+ScmObj ScmOp_SRFI23_error(ScmObj args, ScmObj env)
+{
+ if (NULLP(args))
+ SigScm_Error("error : at least 1 argument required\n");
+
+ if (!STRINGP(CAR(args)))
+ SigScm_ErrorObj("error : first argument should be string but got ", CAR(args));
+
+ /* prepend message */
+ fprintf(SCM_PORTINFO_FILE(scm_current_error_port), "Error: ");
+
+ /* show message */
+ fprintf(SCM_PORTINFO_FILE(scm_current_error_port), "%s", SCM_STRING_STR(CAR(args)));
+
+ /* show each obj */
+ for (args = CDR(args); !NULLP(args); args = CDR(args)) {
+ fprintf(SCM_PORTINFO_FILE(scm_current_error_port), " ");
+
+#if SCM_USE_SRFI38
+ SigScm_WriteToPortWithSharedStructure(scm_current_error_port, CAR(args));
+#else
+ SigScm_WriteToPort(scm_current_error_port, CAR(args));
+#endif
+ }
+
+ /* new line */
+ fprintf(SCM_PORTINFO_FILE(scm_current_error_port), "\n");
+
+ /* show backtrace */
+ SigScm_ShowBacktrace();
+
+ /* TODO: doesn't exit here? */
+ exit(-1);
+
+ return SCM_UNDEF;
+}
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-08-31 22:34:23 UTC (rev 1370)
+++ branches/r5rs/sigscheme/operations.c 2005-08-31 23:11:35 UTC (rev 1371)
@@ -2015,6 +2015,9 @@
#if SCM_USE_SRFI8
#include "operations-srfi8.c"
#endif
+#if SCM_USE_SRFI23
+#include "operations-srfi23.c"
+#endif
#if SCM_USE_SRFI38
#include "operations-srfi38.c"
#endif
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-08-31 22:34:23 UTC (rev 1370)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-08-31 23:11:35 UTC (rev 1371)
@@ -319,6 +319,12 @@
=======================================================================*/
Scm_RegisterFuncRawListTailRec("receive", ScmOp_SRFI8_receive);
#endif
+#if SCM_USE_SRFI23
+ /*=======================================================================
+ SRFI-23 Procedure
+ =======================================================================*/
+ Scm_RegisterFuncEvaledList("error", ScmOp_SRFI23_error);
+#endif
#if SCM_USE_SRFI38
/*=======================================================================
SRFI-8 Procedure
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-08-31 22:34:23 UTC (rev 1370)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-08-31 23:11:35 UTC (rev 1371)
@@ -66,8 +66,9 @@
Macro Declarations
=======================================*/
#define SCM_USE_EUCJP 1 /* use EUC-JP as internal encoding */
-#define SCM_USE_SRFI1 0 /* use SRFI-1 procedures written in C */
+#define SCM_USE_SRFI1 0 /* use SRFI-1 list library procedures written in C */
#define SCM_USE_SRFI8 1 /* use SRFI-8 receive procedure written in C */
+#define SCM_USE_SRFI23 1 /* use SRFI-23 error procedure written in C */
#define SCM_USE_SRFI38 1 /* use SRFI-38 write/ss written in C */
#define SCM_USE_NONSTD_FEATURES 1 /* use Non-R5RS standard features */
#define SCM_COMPAT_SIOD 1 /* use SIOD compatible features */
@@ -83,6 +84,9 @@
/*=======================================
Function Declarations
=======================================*/
+/*===========================================================================
+ SigScheme : Core Functions
+===========================================================================*/
/* sigscheme.c */
void SigScm_Initialize(void);
void SigScm_Finalize(void);
@@ -338,6 +342,10 @@
void SigScm_WriteToPortWithSharedStructure(ScmObj port, ScmObj obj);
#endif
+
+/*===========================================================================
+ SigScheme : Optional Funtions
+===========================================================================*/
#if SCM_USE_SRFI1
/* operations-srfi1.c */
ScmObj ScmOp_SRFI1_xcons(ScmObj a, ScmObj b);
@@ -352,7 +360,12 @@
/* operations-srfi8.c */
ScmObj ScmOp_SRFI8_receive(ScmObj args, ScmObj *envp);
#endif
+#if SCM_USE_SRFI23
+/* operations-srfi23.c */
+ScmObj ScmOp_SRFI23_error(ScmObj args, ScmObj env);
+#endif
#if SCM_USE_SRFI38
+/* operations-srfi38.c */
ScmObj ScmOp_SRFI38_write_with_shared_structure(ScmObj arg, ScmObj env);
#endif
#if SCM_COMPAT_SIOD
More information about the uim-commit
mailing list