[uim-commit] r2035 - in branches/r5rs/sigscheme: . script
kzk at freedesktop.org
kzk at freedesktop.org
Sun Nov 6 09:31:58 PST 2005
Author: kzk
Date: 2005-11-06 09:31:55 -0800 (Sun, 06 Nov 2005)
New Revision: 2035
Added:
branches/r5rs/sigscheme/operations-nonstd.c
Modified:
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/script/build_func_table.rb
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemefunctable.h
Log:
* move nonstd functions to operations-nonstd.c
* sigscheme/sigschemefunctable.h
- (nonstd_func_info_table): new file
* sigscheme/io.c
- (scm_lib_path): renamed from lib_path
- (create_loaded_str, ScmOp_load_path,
ScmOp_require, ScmOp_provide, ScmOp_providep,
ScmOp_file_existsp): move to operations-nonstd.c
* sigscheme/operations.c
- (ScmOp_symbol_boundp, ScmOp_sscm_backtrace)
: move to operations-nonstd.c
- include operations-nonstd.c when SCM_USE_NONSTD_FEATURES is on
* sigscheme/operations-nonstd.c
- (create_loaded_str, ScmOp_load_path,
ScmOp_require, ScmOp_provide, ScmOp_providep,
ScmOp_file_existsp): moved from io.c
- (ScmOp_symbol_boundp, ScmOp_sscm_backtrace)
: moved from operations.c
* sigscheme/sigscheme.c
- (SigScm_Initialize_internal): register nonstd_func_info_table
* sigscheme/sigscheme.h
- update section for SCM_USE_NONSTD_FEATURES
* script/build_func_table.rb
- change to generate nonstd_func_info_table
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2005-11-06 16:59:04 UTC (rev 2034)
+++ branches/r5rs/sigscheme/io.c 2005-11-06 17:31:55 UTC (rev 2035)
@@ -62,7 +62,7 @@
ScmObj SigScm_features = NULL;
-static const char *lib_path = NULL;
+const char *scm_lib_path = NULL;
const ScmSpecialCharInfo Scm_special_char_table[] = {
/* printable characters */
@@ -96,28 +96,16 @@
=======================================*/
static ScmObj SigScm_load_internal(const char *c_filename);
static char* create_valid_path(const char *c_filename);
-#if SCM_USE_NONSTD_FEATURES
-static ScmObj create_loaded_str(ScmObj filename);
static int file_existsp(const char *filepath);
-#endif
/*=======================================
Function Implementations
=======================================*/
void SigScm_set_lib_path(const char *path)
{
- lib_path = path;
+ scm_lib_path = path;
}
-#if SCM_USE_NONSTD_FEATURES
-/* SIOD compatible */
-ScmObj ScmOp_load_path(void)
-{
- DECLARE_FUNCTION("load-path", ProcedureFixed0);
- return Scm_NewStringCopying(lib_path);
-}
-#endif
-
ScmObj Scm_MakeSharedFilePort(FILE *file, const char *aux_info,
enum ScmPortFlag flag)
{
@@ -530,14 +518,14 @@
char *filepath = NULL;
/* construct filepath */
- if (lib_path) {
+ if (scm_lib_path) {
/* try absolute path */
if (file_existsp(c_filename))
return c_filename;
- /* use lib_path */
- filepath = (char*)malloc(strlen(lib_path) + strlen(c_filename) + 2);
- strcpy(filepath, lib_path);
+ /* use scm_lib_path */
+ filepath = (char*)malloc(strlen(scm_lib_path) + strlen(c_filename) + 2);
+ strcpy(filepath, scm_lib_path);
strcat(filepath, "/");
strcat(filepath, c_filename);
if (file_existsp(filepath)) {
@@ -563,6 +551,16 @@
return NULL;
}
+static int file_existsp(const char *c_filepath)
+{
+ FILE *f = fopen(c_filepath, "r");
+ if (!f)
+ return 0;
+
+ fclose(f);
+ return 1;
+}
+
ScmObj ScmOp_load(ScmObj filename)
{
char *c_filename = SCM_STRING_STR(filename);
@@ -577,119 +575,6 @@
#endif
}
-#if SCM_USE_NONSTD_FEATURES
-/* FIXME: add ScmObj SigScm_require(const char *c_filename) */
-
-ScmObj ScmOp_require(ScmObj filename)
-{
- ScmObj loaded_str = SCM_FALSE;
-#if SCM_COMPAT_SIOD
- ScmObj retsym = SCM_FALSE;
-#endif
- DECLARE_FUNCTION("require", ProcedureFixed1);
-
- ASSERT_STRINGP(filename);
-
- loaded_str = create_loaded_str(filename);
- if (FALSEP(ScmOp_providedp(loaded_str))) {
- ScmOp_load(filename);
- ScmOp_provide(loaded_str);
- }
-
-#if SCM_COMPAT_SIOD
- retsym = Scm_Intern(SCM_STRING_STR(loaded_str));
- SCM_SYMBOL_SET_VCELL(retsym, SCM_TRUE);
-
- return retsym;
-#else
- return SCM_TRUE;
-#endif
-}
-
-static ScmObj create_loaded_str(ScmObj filename)
-{
- char *loaded_str = NULL;
- int size = 0;
-
- /* generate loaded_str, contents is filename-loaded* */
- size = (strlen(SCM_STRING_STR(filename)) + strlen("*-loaded*") + 1);
- loaded_str = (char*)malloc(sizeof(char) * size);
- snprintf(loaded_str, size, "*%s-loaded*", SCM_STRING_STR(filename));
-
- return Scm_NewString(loaded_str);
-}
-
-/*
- * TODO: replace original specification with a SRFI standard or other de facto
- * standard
- */
-ScmObj ScmOp_provide(ScmObj feature)
-{
- DECLARE_FUNCTION("provide", ProcedureFixed1);
-
- ASSERT_STRINGP(feature);
-
- /* record to SigScm_features */
- SCM_SYMBOL_SET_VCELL(SigScm_features,
- CONS(feature, SCM_SYMBOL_VCELL(SigScm_features)));
-
- return SCM_TRUE;
-}
-
-/*
- * TODO: replace original specification with a SRFI standard or other de facto
- * standard
- */
-ScmObj ScmOp_providedp(ScmObj feature)
-{
- ScmObj provided = SCM_FALSE;
- DECLARE_FUNCTION("provided?", ProcedureFixed1);
-
- ASSERT_STRINGP(feature);
-
- provided = ScmOp_member(feature, SCM_SYMBOL_VCELL(SigScm_features));
-
- return (NFALSEP(provided)) ? SCM_TRUE : SCM_FALSE;
-}
-
-/*
- * TODO: describe compatibility with de facto standard of other Scheme
- * implementations
- */
-ScmObj ScmOp_file_existsp(ScmObj filepath)
-{
- DECLARE_FUNCTION("file-exists?", ProcedureFixed1);
-
- ASSERT_STRINGP(filepath);
-
- return (file_existsp(SCM_STRING_STR(filepath))) ? SCM_TRUE : SCM_FALSE;
-}
-
-/* TODO: remove to ensure security */
-ScmObj ScmOp_delete_file(ScmObj filepath)
-{
- DECLARE_FUNCTION("delete-file", ProcedureFixed1);
-
- ASSERT_STRINGP(filepath);
-
- if (remove(SCM_STRING_STR(filepath)) == -1)
- ERR_OBJ("delete failed. file = ", filepath);
-
- return SCM_TRUE;
-}
-
-static int file_existsp(const char *c_filepath)
-{
- FILE *f = fopen(c_filepath, "r");
- if (!f)
- return 0;
-
- fclose(f);
- return 1;
-}
-#endif /* SCM_USE_NONSTD_FEATURES */
-
-
/* FIXME: link conditionally with autoconf */
#include "sbcport.c"
#include "fileport.c"
Added: branches/r5rs/sigscheme/operations-nonstd.c
===================================================================
--- branches/r5rs/sigscheme/operations-nonstd.c 2005-11-06 16:59:04 UTC (rev 2034)
+++ branches/r5rs/sigscheme/operations-nonstd.c 2005-11-06 17:31:55 UTC (rev 2035)
@@ -0,0 +1,207 @@
+/*===========================================================================
+ * FileName : operations-nonstd.c
+ * About : SigScheme specific non standard operations
+ *
+ * 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
+=======================================*/
+
+/*=======================================
+ File Local Macro Definitions
+=======================================*/
+
+/*=======================================
+ File Local Type Definitions
+=======================================*/
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+/* io.c */
+extern const char *scm_lib_path;
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+static ScmObj create_loaded_str(ScmObj filename);
+
+/*=======================================
+ Function Implementations
+=======================================*/
+/*
+ * TODO:
+ * - describe compatibility with de facto standard of other Scheme
+ * implementations (accept env as optional arg, etc)
+ */
+/* The implementation is fully compatible with SIOD */
+ScmObj ScmOp_symbol_boundp(ScmObj sym, ScmObj rest)
+{
+ ScmObj env = SCM_INVALID;
+ DECLARE_FUNCTION("symbol-bound?", ProcedureVariadic1);
+
+ ASSERT_SYMBOLP(sym);
+
+ env = POP_ARG(rest);
+ if (VALIDP(env))
+ ASSERT_ENVP(env);
+ else
+ env = SCM_INTERACTION_ENV;
+
+ return (!NULLP(Scm_LookupEnvironment(sym, env))
+ || SCM_SYMBOL_BOUNDP(sym)) ? SCM_TRUE : SCM_FALSE;
+}
+
+ScmObj ScmOp_sscm_backtrace(void)
+{
+ DECLARE_FUNCTION("%%backtrace", ProcedureFixed0);
+
+ SigScm_ShowBacktrace();
+
+ return SCM_UNDEF;
+}
+
+/* SIOD compatible */
+ScmObj ScmOp_load_path(void)
+{
+ DECLARE_FUNCTION("load-path", ProcedureFixed0);
+ return Scm_NewStringCopying(scm_lib_path);
+}
+
+/* FIXME: add ScmObj SigScm_require(const char *c_filename) */
+ScmObj ScmOp_require(ScmObj filename)
+{
+ ScmObj loaded_str = SCM_FALSE;
+#if SCM_COMPAT_SIOD
+ ScmObj retsym = SCM_FALSE;
+#endif
+ DECLARE_FUNCTION("require", ProcedureFixed1);
+
+ ASSERT_STRINGP(filename);
+
+ loaded_str = create_loaded_str(filename);
+ if (FALSEP(ScmOp_providedp(loaded_str))) {
+ ScmOp_load(filename);
+ ScmOp_provide(loaded_str);
+ }
+
+#if SCM_COMPAT_SIOD
+ retsym = Scm_Intern(SCM_STRING_STR(loaded_str));
+ SCM_SYMBOL_SET_VCELL(retsym, SCM_TRUE);
+
+ return retsym;
+#else
+ return SCM_TRUE;
+#endif
+}
+
+static ScmObj create_loaded_str(ScmObj filename)
+{
+ char *loaded_str = NULL;
+ int size = 0;
+
+ /* generate loaded_str, contents is filename-loaded* */
+ size = (strlen(SCM_STRING_STR(filename)) + strlen("*-loaded*") + 1);
+ loaded_str = (char*)malloc(sizeof(char) * size);
+ snprintf(loaded_str, size, "*%s-loaded*", SCM_STRING_STR(filename));
+
+ return Scm_NewString(loaded_str);
+}
+
+/*
+ * TODO: replace original specification with a SRFI standard or other de facto
+ * standard
+ */
+ScmObj ScmOp_provide(ScmObj feature)
+{
+ DECLARE_FUNCTION("provide", ProcedureFixed1);
+
+ ASSERT_STRINGP(feature);
+
+ /* record to SigScm_features */
+ SCM_SYMBOL_SET_VCELL(SigScm_features,
+ CONS(feature, SCM_SYMBOL_VCELL(SigScm_features)));
+
+ return SCM_TRUE;
+}
+
+/*
+ * TODO: replace original specification with a SRFI standard or other de facto
+ * standard
+ */
+ScmObj ScmOp_providedp(ScmObj feature)
+{
+ ScmObj provided = SCM_FALSE;
+ DECLARE_FUNCTION("provided?", ProcedureFixed1);
+
+ ASSERT_STRINGP(feature);
+
+ provided = ScmOp_member(feature, SCM_SYMBOL_VCELL(SigScm_features));
+
+ return (NFALSEP(provided)) ? SCM_TRUE : SCM_FALSE;
+}
+
+/*
+ * TODO: describe compatibility with de facto standard of other Scheme
+ * implementations
+ */
+ScmObj ScmOp_file_existsp(ScmObj filepath)
+{
+ FILE *f;
+ DECLARE_FUNCTION("file-exists?", ProcedureFixed1);
+
+ ASSERT_STRINGP(filepath);
+
+ f = fopen(SCM_STRING_STR(filepath), "r");
+ if (!f)
+ return SCM_FALSE;
+ fclose(f);
+
+ return SCM_TRUE;
+}
+
+/* TODO: remove to ensure security */
+ScmObj ScmOp_delete_file(ScmObj filepath)
+{
+ DECLARE_FUNCTION("delete-file", ProcedureFixed1);
+
+ ASSERT_STRINGP(filepath);
+
+ if (remove(SCM_STRING_STR(filepath)) == -1)
+ ERR_OBJ("delete failed. file = ", filepath);
+
+ return SCM_TRUE;
+}
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-11-06 16:59:04 UTC (rev 2034)
+++ branches/r5rs/sigscheme/operations.c 2005-11-06 17:31:55 UTC (rev 2035)
@@ -1748,47 +1748,12 @@
return Scm_DynamicWind(before, thunk, after);
}
-/*============================================================================
- SigScheme-Specific Non-R5RS Standard Procedures
-============================================================================*/
-#if SCM_USE_NONSTD_FEATURES
-/*
- * TODO:
- * - describe compatibility with de facto standard of other Scheme
- * implementations (accept env as optional arg, etc)
- */
-/* The implementation is fully compatible with SIOD */
-ScmObj ScmOp_symbol_boundp(ScmObj sym, ScmObj rest)
-{
- ScmObj env = SCM_INVALID;
- DECLARE_FUNCTION("symbol-bound?", ProcedureVariadic1);
-
- ASSERT_SYMBOLP(sym);
-
- env = POP_ARG(rest);
- if (VALIDP(env))
- ASSERT_ENVP(env);
- else
- env = SCM_INTERACTION_ENV;
-
- return (!NULLP(Scm_LookupEnvironment(sym, env))
- || SCM_SYMBOL_BOUNDP(sym)) ? SCM_TRUE : SCM_FALSE;
-}
-
-ScmObj ScmOp_sscm_backtrace(void)
-{
- DECLARE_FUNCTION("%%backtrace", ProcedureFixed0);
-
- SigScm_ShowBacktrace();
-
- return SCM_UNDEF;
-}
-#endif /* SCM_USE_NONSTD_FEATURES */
-
#if SCM_USE_DEEP_CADRS
#include "operations-r5rs-deepcadrs.c"
-#endif /* SCM_USE_DEEP_CADRS */
-
+#endif
+#if SCM_USE_NONSTD_FEATURES
+#include "operations-nonstd.c"
+#endif
#if SCM_USE_SRFI1
#include "operations-srfi1.c"
#endif
Modified: branches/r5rs/sigscheme/script/build_func_table.rb
===================================================================
--- branches/r5rs/sigscheme/script/build_func_table.rb 2005-11-06 16:59:04 UTC (rev 2034)
+++ branches/r5rs/sigscheme/script/build_func_table.rb 2005-11-06 17:31:55 UTC (rev 2035)
@@ -169,6 +169,11 @@
"r5rs_deepcadrs_func_info_table",
["operations-r5rs-deepcadrs.c"])
+# SigScheme specific non standard operations
+build_functable("",
+ "nonstd_func_info_table",
+ ["operations-nonstd.c"])
+
# SRFI-1
build_functable("_SRFI1_",
"srfi1_func_info_table",
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-11-06 16:59:04 UTC (rev 2034)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-11-06 17:31:55 UTC (rev 2035)
@@ -181,6 +181,7 @@
REGISTER_FUNC_TABLE(r5rs_deepcadrs_func_info_table);
#endif
#if SCM_USE_NONSTD_FEATURES
+ REGISTER_FUNC_TABLE(nonstd_func_info_table);
Scm_DefineAlias("call/cc", "call-with-current-continuation");
#endif
#else /* SCM_USE_REGISTER_TABLE */
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-11-06 16:59:04 UTC (rev 2034)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-11-06 17:31:55 UTC (rev 2035)
@@ -535,10 +535,6 @@
ScmObj ScmOp_values(ScmObj args);
ScmObj ScmOp_call_with_values(ScmObj producer, ScmObj consumer, ScmEvalState *eval_state);
ScmObj ScmOp_dynamic_wind(ScmObj before, ScmObj thunk, ScmObj after);
-#if SCM_USE_NONSTD_FEATURES
-ScmObj ScmOp_symbol_boundp(ScmObj sym, ScmObj rest);
-ScmObj ScmOp_sscm_backtrace(void);
-#endif
/* operations-r5rs-deepcadrs.c */
#if SCM_USE_DEEP_CADRS
@@ -566,6 +562,19 @@
ScmObj ScmOp_cddddr(ScmObj lst);
#endif /* SCM_USE_DEEP_CADRS */
+/* operations-nonstd.c */
+#if SCM_USE_NONSTD_FEATURES
+ScmObj ScmOp_symbol_boundp(ScmObj sym, ScmObj rest);
+ScmObj ScmOp_sscm_backtrace(void);
+ScmObj ScmOp_load_path(void);
+/* FIXME: add ScmObj SigScm_require(const char *c_filename); */
+ScmObj ScmOp_require(ScmObj filename);
+ScmObj ScmOp_provide(ScmObj feature);
+ScmObj ScmOp_providedp(ScmObj feature);
+ScmObj ScmOp_file_existsp(ScmObj filepath);
+ScmObj ScmOp_delete_file(ScmObj filepath);
+#endif
+
/* io.c */
void SigScm_set_lib_path(const char *path);
ScmObj Scm_MakeSharedFilePort(FILE *file, const char *aux_info,
@@ -602,15 +611,6 @@
ScmObj SigScm_load(const char *c_filename);
ScmObj ScmOp_load(ScmObj filename);
-#if SCM_USE_NONSTD_FEATURES
-ScmObj ScmOp_load_path(void);
-/* FIXME: add ScmObj SigScm_require(const char *c_filename); */
-ScmObj ScmOp_require(ScmObj filename);
-ScmObj ScmOp_provide(ScmObj feature);
-ScmObj ScmOp_providedp(ScmObj feature);
-ScmObj ScmOp_file_existsp(ScmObj filepath);
-ScmObj ScmOp_delete_file(ScmObj filepath);
-#endif
/* read.c */
ScmObj SigScm_Read(ScmObj port);
Modified: branches/r5rs/sigscheme/sigschemefunctable.h
===================================================================
--- branches/r5rs/sigscheme/sigschemefunctable.h 2005-11-06 16:59:04 UTC (rev 2034)
+++ branches/r5rs/sigscheme/sigschemefunctable.h 2005-11-06 17:31:55 UTC (rev 2035)
@@ -68,6 +68,7 @@
=======================================*/
extern struct builtin_func_info r5rs_func_info_table[];
extern struct builtin_func_info r5rs_deepcadrs_func_info_table[];
+extern struct builtin_func_info nonstd_func_info_table[];
extern struct builtin_func_info srfi1_func_info_table[];
extern struct builtin_func_info srfi2_func_info_table[];
extern struct builtin_func_info srfi6_func_info_table[];
More information about the uim-commit
mailing list