[uim-commit] r3025 - branches/r5rs/sigscheme/src
yamaken at freedesktop.org
yamaken at freedesktop.org
Sun Jan 29 15:20:37 PST 2006
Author: yamaken
Date: 2006-01-29 15:20:33 -0800 (Sun, 29 Jan 2006)
New Revision: 3025
Added:
branches/r5rs/sigscheme/src/module.c
Modified:
branches/r5rs/sigscheme/src/Makefile.am
branches/r5rs/sigscheme/src/operations.c
branches/r5rs/sigscheme/src/sigscheme.c
branches/r5rs/sigscheme/src/sigscheme.h
branches/r5rs/sigscheme/src/sigschemeinternal.h
branches/r5rs/sigscheme/src/syntax.c
Log:
* sigscheme/src/sigschemeinternal.h
- (scm_init_module): New function decl
* sigscheme/src/module.c
- New file copied from sigscheme.c
- (struct module_info, features, module_info_table,
scm_use_internal, scm_register_func, scm_provide, scm_providedp,
scm_use, scm_s_use, scm_define_alias
scm_register_reduction_operator, scm_register_syntax_fixed_0,
scm_register_syntax_fixed_1, scm_register_syntax_fixed_2,
scm_register_syntax_fixed_3, scm_register_syntax_fixed_4,
scm_register_syntax_fixed_5, scm_register_syntax_fixed_tailrec_0,
scm_register_syntax_fixed_tailrec_1,
scm_register_syntax_fixed_tailrec_2,
scm_register_syntax_fixed_tailrec_3,
scm_register_syntax_fixed_tailrec_4,
scm_register_syntax_fixed_tailrec_5,
scm_register_syntax_variadic_0, scm_register_syntax_variadic_1,
scm_register_syntax_variadic_2, scm_register_syntax_variadic_3,
scm_register_syntax_variadic_4, scm_register_syntax_variadic_5,
scm_register_syntax_variadic_tailrec_0,
scm_register_syntax_variadic_tailrec_1,
scm_register_syntax_variadic_tailrec_2,
scm_register_syntax_variadic_tailrec_3,
scm_register_syntax_variadic_tailrec_4,
scm_register_syntax_variadic_tailrec_5,
scm_register_procedure_fixed_0, scm_register_procedure_fixed_1,
scm_register_procedure_fixed_2, scm_register_procedure_fixed_3,
scm_register_procedure_fixed_4, scm_register_procedure_fixed_5,
scm_register_procedure_fixed_tailrec_0,
scm_register_procedure_fixed_tailrec_1,
scm_register_procedure_fixed_tailrec_2,
scm_register_procedure_fixed_tailrec_3,
scm_register_procedure_fixed_tailrec_4,
scm_register_procedure_fixed_tailrec_5,
scm_register_procedure_variadic_0,
scm_register_procedure_variadic_1,
scm_register_procedure_variadic_2,
scm_register_procedure_variadic_3,
scm_register_procedure_variadic_4,
scm_register_procedure_variadic_5,
scm_register_procedure_variadic_tailrec_0,
scm_register_procedure_variadic_tailrec_1,
scm_register_procedure_variadic_tailrec_2,
scm_register_procedure_variadic_tailrec_3,
scm_register_procedure_variadic_tailrec_4,
scm_register_procedure_variadic_tailrec_5): Moved from sigscheme.c
* sigscheme/src/sigscheme.c
- (struct module_info, features, module_info_table,
scm_use_internal, scm_register_func, scm_provide, scm_providedp,
scm_use, scm_s_use, scm_define_alias
scm_register_reduction_operator, scm_register_syntax_fixed_0,
scm_register_syntax_fixed_1, scm_register_syntax_fixed_2,
scm_register_syntax_fixed_3, scm_register_syntax_fixed_4,
scm_register_syntax_fixed_5, scm_register_syntax_fixed_tailrec_0,
scm_register_syntax_fixed_tailrec_1,
scm_register_syntax_fixed_tailrec_2,
scm_register_syntax_fixed_tailrec_3,
scm_register_syntax_fixed_tailrec_4,
scm_register_syntax_fixed_tailrec_5,
scm_register_syntax_variadic_0, scm_register_syntax_variadic_1,
scm_register_syntax_variadic_2, scm_register_syntax_variadic_3,
scm_register_syntax_variadic_4, scm_register_syntax_variadic_5,
scm_register_syntax_variadic_tailrec_0,
scm_register_syntax_variadic_tailrec_1,
scm_register_syntax_variadic_tailrec_2,
scm_register_syntax_variadic_tailrec_3,
scm_register_syntax_variadic_tailrec_4,
scm_register_syntax_variadic_tailrec_5,
scm_register_procedure_fixed_0, scm_register_procedure_fixed_1,
scm_register_procedure_fixed_2, scm_register_procedure_fixed_3,
scm_register_procedure_fixed_4, scm_register_procedure_fixed_5,
scm_register_procedure_fixed_tailrec_0,
scm_register_procedure_fixed_tailrec_1,
scm_register_procedure_fixed_tailrec_2,
scm_register_procedure_fixed_tailrec_3,
scm_register_procedure_fixed_tailrec_4,
scm_register_procedure_fixed_tailrec_5,
scm_register_procedure_variadic_0,
scm_register_procedure_variadic_1,
scm_register_procedure_variadic_2,
scm_register_procedure_variadic_3,
scm_register_procedure_variadic_4,
scm_register_procedure_variadic_5,
scm_register_procedure_variadic_tailrec_0,
scm_register_procedure_variadic_tailrec_1,
scm_register_procedure_variadic_tailrec_2,
scm_register_procedure_variadic_tailrec_3,
scm_register_procedure_variadic_tailrec_4,
scm_register_procedure_variadic_tailrec_5): Move to module.c
- (scm_sym_quote, scm_sym_quasiquote, scm_sym_unquote,
scm_sym_unquote_splicing): Move to syntax.c
- (scm_identifier_codec): Move to operations.c
- (scm_initialize_internal):
* Add scm_init_module()
* Move initializations to scm_init_module() and scm_init_syntax()
* sigscheme/src/syntax.c
- (scm_sym_quote, scm_sym_quasiquote, scm_sym_unquote,
scm_sym_unquote_splicing): Moved from sigscheme.c
- (scm_init_syntax): Add initializations for the symbols
* sigscheme/src/operations.c
- (scm_identifier_codec): Moved from sigscheme.c
* sigscheme/src/sigscheme.h
- Move prototype section
* sigscheme/src/Makefile.am
- (libsscm_la_SOURCES): Add module.c
- Add module.c to the rule for sigschemefunctable-r5rs-syntax.c
Modified: branches/r5rs/sigscheme/src/Makefile.am
===================================================================
--- branches/r5rs/sigscheme/src/Makefile.am 2006-01-29 22:05:11 UTC (rev 3024)
+++ branches/r5rs/sigscheme/src/Makefile.am 2006-01-29 23:20:33 UTC (rev 3025)
@@ -27,8 +27,9 @@
vector.c port.c read.c write.c load.c
sigschemefunctable.c: $(FUNC_TABLES)
-sigschemefunctable-r5rs-syntax.c: syntax.c $(BUILD_FUNCTBL_SOURCES)
- $(BUILD_FUNCTBL) "scm_r5rs_syntax_func_info_table" $< > $@
+sigschemefunctable-r5rs-syntax.c: syntax.c module.c $(BUILD_FUNCTBL_SOURCES)
+ $(BUILD_FUNCTBL) "scm_r5rs_syntax_func_info_table" \
+ syntax.c module.c > $@
sigschemefunctable-r5rs-procedure.c: $(R5RS_PROC_SRCS) $(BUILD_FUNCTBL_SOURCES)
$(BUILD_FUNCTBL) "scm_r5rs_procedure_func_info_table" \
$(R5RS_PROC_SRCS) > $@
@@ -65,7 +66,7 @@
storage-continuation.c \
encoding.c error.c \
env.c eval.c syntax.c list.c number.c string.c vector.c \
- port.c read.c write.c load.c\
+ port.c read.c write.c load.c module.c \
basecport.c fileport.c \
operations.c \
sigscheme.c sigschemefunctable.c \
Copied: branches/r5rs/sigscheme/src/module.c (from rev 3024, branches/r5rs/sigscheme/src/sigscheme.c)
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.c 2006-01-29 22:05:11 UTC (rev 3024)
+++ branches/r5rs/sigscheme/src/module.c 2006-01-29 23:20:33 UTC (rev 3025)
@@ -0,0 +1,545 @@
+/*===========================================================================
+ * FileName : module.c
+ * About : Code module handlings
+ *
+ * Copyright (C) 2005-2006 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 <stddef.h>
+#include <string.h>
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+ File Local Struct Declarations
+=======================================*/
+struct module_info {
+ const char *name;
+ void (*initializer)(void);
+};
+
+/*=======================================
+ File Local Macro Declarations
+=======================================*/
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+static ScmObj features;
+
+static struct module_info module_info_table[] = {
+#if SCM_USE_NONSTD_FEATURES
+ {"sscm", scm_initialize_nonstd_features},
+#endif
+#if SCM_USE_SRFI1
+ {"srfi-1", scm_initialize_srfi1},
+#endif
+#if SCM_USE_SRFI2
+ {"srfi-2", scm_initialize_srfi2},
+#endif
+#if SCM_USE_SRFI6
+ {"srfi-6", scm_initialize_srfi6},
+#endif
+#if SCM_USE_SRFI8
+ {"srfi-8", scm_initialize_srfi8},
+#endif
+#if SCM_USE_SRFI23
+ {"srfi-23", scm_initialize_srfi23},
+#endif
+#if SCM_USE_SRFI34
+ {"srfi-34", scm_initialize_srfi34},
+#endif
+#if SCM_USE_SRFI38
+ {"srfi-38", scm_initialize_srfi38},
+#endif
+#if SCM_USE_SRFI60
+ {"srfi-60", scm_initialize_srfi60},
+#endif
+#if SCM_COMPAT_SIOD
+ {"siod", scm_initialize_siod},
+#endif
+ {NULL, NULL}
+};
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+static scm_bool scm_use_internal(const char *feature);
+static scm_bool scm_register_func(const char *name, ScmFuncType func,
+ enum ScmFuncTypeCode type);
+
+/*=======================================
+ Function Implementations
+=======================================*/
+void
+scm_init_module(void)
+{
+ scm_gc_protect_with_init(&features, SCM_NULL);
+}
+
+void
+scm_provide(ScmObj feature)
+{
+ features = CONS(feature, features);
+}
+
+scm_bool
+scm_providedp(ScmObj feature)
+{
+ return NFALSEP(scm_p_member(feature, features));
+}
+
+scm_bool
+scm_use(const char *feature)
+{
+ scm_bool ok;
+#if !SCM_GCC4_READY_GC
+ ScmObj stack_start;
+#endif
+
+#if SCM_GCC4_READY_GC
+ SCM_GC_PROTECTED_CALL(ok, scm_bool, scm_use_internal, (feature));
+#else
+ scm_gc_protect_stack(&stack_start);
+
+ ok = scm_use_internal(feature);
+
+ scm_gc_unprotect_stack(&stack_start);
+#endif
+
+ return ok;
+}
+
+static scm_bool
+scm_use_internal(const char *feature)
+{
+ ScmObj ok;
+
+ SCM_ASSERT(feature);
+
+ ok = scm_s_use(scm_intern(feature), SCM_INTERACTION_ENV);
+ return NFALSEP(ok);
+}
+
+/*
+ * TODO:
+ * - Make the interface and semantics of 'use' similar to other Scheme
+ * implementations such as Gauche. This is important to make *.scm file
+ * portable
+ * - Make a *.scm file loadable via this interface (if necessary to make
+ * similar to other Scheme implementations), and make consistent with
+ * 'require'
+ * - Make the 'module' concept similar to other Scheme implementations and R6RS
+ * - Make the module_info_table dynamically registerable for dynamic loadable
+ * objects (if necessary)
+ */
+ScmObj
+scm_s_use(ScmObj feature, ScmObj env)
+{
+ struct module_info *mod;
+ ScmObj feature_str;
+ const char *c_feature_str;
+ DECLARE_FUNCTION("use", syntax_fixed_1);
+
+ ENSURE_SYMBOL(feature);
+
+ c_feature_str = SCM_SYMBOL_NAME(feature);
+
+ for (mod = module_info_table; mod->name; mod++) {
+ if (strcmp(c_feature_str, mod->name) == 0) {
+ feature_str = CONST_STRING(c_feature_str);
+ if (!scm_providedp(feature_str)) {
+ (*mod->initializer)();
+ scm_provide(feature_str);
+ }
+ return SCM_TRUE;
+ }
+ }
+
+ return SCM_FALSE;
+}
+
+/*===========================================================================
+ Scheme Function Export Related Functions
+===========================================================================*/
+void
+scm_define_alias(const char *newsym, const char *sym)
+{
+ SCM_SYMBOL_SET_VCELL(scm_intern(newsym),
+ SCM_SYMBOL_VCELL(scm_intern(sym)));
+}
+
+static scm_bool
+scm_register_func(const char *name, ScmFuncType c_func,
+ enum ScmFuncTypeCode type)
+{
+ ScmObj sym, func;
+
+ sym = scm_intern(name);
+ func = MAKE_FUNC(type, c_func);
+
+ /* TODO: reject bad TYPE */
+ SCM_SYMBOL_SET_VCELL(sym, func);
+ return scm_true;
+}
+
+/* Not implemented yet. */
+void scm_register_reduction_operator(const char *name, ScmObj (*func)(ScmObj, ScmObj, enum ScmReductionState*))
+{
+ scm_register_func(name, func, SCM_REDUCTION_OPERATOR);
+}
+
+/* So, yeah, um... this isn't really such a big deal if you think
+ * about W32.... */
+void scm_register_syntax_fixed_0(const char *name, ScmObj (*func)(ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void scm_register_syntax_fixed_1(const char *name, ScmObj (*func)(ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void scm_register_syntax_fixed_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void scm_register_syntax_fixed_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void scm_register_syntax_fixed_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void scm_register_syntax_fixed_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED | 5);
+}
+#endif
+
+void scm_register_syntax_fixed_tailrec_0(const char *name, ScmObj (*func)(ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void scm_register_syntax_fixed_tailrec_1(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void scm_register_syntax_fixed_tailrec_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void scm_register_syntax_fixed_tailrec_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void scm_register_syntax_fixed_tailrec_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void scm_register_syntax_fixed_tailrec_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 5);
+}
+#endif
+
+void scm_register_syntax_variadic_0(const char *name, ScmObj (*func)(ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void scm_register_syntax_variadic_1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void scm_register_syntax_variadic_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void scm_register_syntax_variadic_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void scm_register_syntax_variadic_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void scm_register_syntax_variadic_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 5);
+}
+#endif
+
+void scm_register_syntax_variadic_tailrec_0(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void scm_register_syntax_variadic_tailrec_1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void scm_register_syntax_variadic_tailrec_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void scm_register_syntax_variadic_tailrec_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void scm_register_syntax_variadic_tailrec_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void scm_register_syntax_variadic_tailrec_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 5);
+}
+#endif
+
+void scm_register_procedure_fixed_0(const char *name, ScmObj (*func)())
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void scm_register_procedure_fixed_1(const char *name, ScmObj (*func)(ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void scm_register_procedure_fixed_2(const char *name, ScmObj (*func)(ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void scm_register_procedure_fixed_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void scm_register_procedure_fixed_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void scm_register_procedure_fixed_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED | 5);
+}
+#endif
+
+void scm_register_procedure_fixed_tailrec_0(const char *name, ScmObj (*func)(ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void scm_register_procedure_fixed_tailrec_1(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void scm_register_procedure_fixed_tailrec_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void scm_register_procedure_fixed_tailrec_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void scm_register_procedure_fixed_tailrec_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void scm_register_procedure_fixed_tailrec_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 5);
+}
+#endif
+
+void scm_register_procedure_variadic_0(const char *name, ScmObj (*func)(ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void scm_register_procedure_variadic_1(const char *name, ScmObj (*func)(ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void scm_register_procedure_variadic_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void scm_register_procedure_variadic_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void scm_register_procedure_variadic_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void scm_register_procedure_variadic_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 5);
+}
+#endif
+
+void scm_register_procedure_variadic_tailrec_0(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 0);
+}
+
+#if SCM_FUNCTYPE_MAND_MAX >= 1
+void scm_register_procedure_variadic_tailrec_1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 1);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 2
+void scm_register_procedure_variadic_tailrec_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 2);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 3
+void scm_register_procedure_variadic_tailrec_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 3);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 4
+void scm_register_procedure_variadic_tailrec_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 4);
+}
+#endif
+
+#if SCM_FUNCTYPE_MAND_MAX >= 5
+void scm_register_procedure_variadic_tailrec_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
+{
+ scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 5);
+}
+#endif
Modified: branches/r5rs/sigscheme/src/operations.c
===================================================================
--- branches/r5rs/sigscheme/src/operations.c 2006-01-29 22:05:11 UTC (rev 3024)
+++ branches/r5rs/sigscheme/src/operations.c 2006-01-29 23:20:33 UTC (rev 3025)
@@ -58,6 +58,8 @@
/*=======================================
Variable Declarations
=======================================*/
+/* canonical internal encoding for identifiers */
+ScmCharCodec *scm_identifier_codec;
/*=======================================
File Local Function Declarations
Modified: branches/r5rs/sigscheme/src/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.c 2006-01-29 22:05:11 UTC (rev 3024)
+++ branches/r5rs/sigscheme/src/sigscheme.c 2006-01-29 23:20:33 UTC (rev 3025)
@@ -50,10 +50,6 @@
/*=======================================
File Local Struct Declarations
=======================================*/
-struct module_info {
- const char *name;
- void (*initializer)(void);
-};
/*=======================================
File Local Macro Declarations
@@ -62,60 +58,16 @@
/*=======================================
Variable Declarations
=======================================*/
-ScmObj scm_sym_quote, scm_sym_quasiquote;
-ScmObj scm_sym_unquote, scm_sym_unquote_splicing;
-
-/* canonical internal encoding for identifiers */
-ScmCharCodec *scm_identifier_codec;
-
static scm_bool scm_initialized;
-static ScmObj features;
#if SCM_COMPAT_SIOD
static ScmObj scm_return_value_cache = NULL;
#endif
-static struct module_info module_info_table[] = {
-#if SCM_USE_NONSTD_FEATURES
- {"sscm", scm_initialize_nonstd_features},
-#endif
-#if SCM_USE_SRFI1
- {"srfi-1", scm_initialize_srfi1},
-#endif
-#if SCM_USE_SRFI2
- {"srfi-2", scm_initialize_srfi2},
-#endif
-#if SCM_USE_SRFI6
- {"srfi-6", scm_initialize_srfi6},
-#endif
-#if SCM_USE_SRFI8
- {"srfi-8", scm_initialize_srfi8},
-#endif
-#if SCM_USE_SRFI23
- {"srfi-23", scm_initialize_srfi23},
-#endif
-#if SCM_USE_SRFI34
- {"srfi-34", scm_initialize_srfi34},
-#endif
-#if SCM_USE_SRFI38
- {"srfi-38", scm_initialize_srfi38},
-#endif
-#if SCM_USE_SRFI60
- {"srfi-60", scm_initialize_srfi60},
-#endif
-#if SCM_COMPAT_SIOD
- {"siod", scm_initialize_siod},
-#endif
- {NULL, NULL}
-};
-
/*=======================================
File Local Function Declarations
=======================================*/
static void scm_initialize_internal(const ScmStorageConf *storage_conf);
-static scm_bool scm_use_internal(const char *feature);
-static scm_bool scm_register_func(const char *name, ScmFuncType func,
- enum ScmFuncTypeCode type);
static ScmObj scm_eval_c_string_internal(const char *exp);
/*=======================================
@@ -152,21 +104,12 @@
scm_init_storage(storage_conf);
scm_init_error();
scm_init_port();
+ scm_init_module();
/* fallback to unibyte */
scm_identifier_codec = scm_mb_find_codec("UTF-8");
/*=======================================================================
- Predefined Symbols and Variables
- =======================================================================*/
- scm_sym_quote = scm_intern("quote");
- scm_sym_quasiquote = scm_intern("quasiquote");
- scm_sym_unquote = scm_intern("unquote");
- scm_sym_unquote_splicing = scm_intern("unquote-splicing");
-
- scm_gc_protect_with_init(&features, SCM_NULL);
-
- /*=======================================================================
Register Built-in Functions
=======================================================================*/
/* R5RS Syntaxes */
@@ -222,96 +165,7 @@
scm_initialized = scm_false;
}
-void
-scm_define_alias(const char *newsym, const char *sym)
-{
- SCM_SYMBOL_SET_VCELL(scm_intern(newsym),
- SCM_SYMBOL_VCELL(scm_intern(sym)));
-}
-
-void
-scm_provide(ScmObj feature)
-{
- features = CONS(feature, features);
-}
-
-scm_bool
-scm_providedp(ScmObj feature)
-{
- return NFALSEP(scm_p_member(feature, features));
-}
-
-scm_bool
-scm_use(const char *feature)
-{
- scm_bool ok;
-#if !SCM_GCC4_READY_GC
- ScmObj stack_start;
-#endif
-
-#if SCM_GCC4_READY_GC
- SCM_GC_PROTECTED_CALL(ok, scm_bool, scm_use_internal, (feature));
-#else
- scm_gc_protect_stack(&stack_start);
-
- ok = scm_use_internal(feature);
-
- scm_gc_unprotect_stack(&stack_start);
-#endif
-
- return ok;
-}
-
-static scm_bool
-scm_use_internal(const char *feature)
-{
- ScmObj ok;
-
- SCM_ASSERT(feature);
-
- ok = scm_s_use(scm_intern(feature), SCM_INTERACTION_ENV);
- return NFALSEP(ok);
-}
-
-/*
- * TODO:
- * - Make the interface and semantics of 'use' similar to other Scheme
- * implementations such as Gauche. This is important to make *.scm file
- * portable
- * - Make a *.scm file loadable via this interface (if necessary to make
- * similar to other Scheme implementations), and make consistent with
- * 'require'
- * - Make the 'module' concept similar to other Scheme implementations and R6RS
- * - Make the module_info_table dynamically registerable for dynamic loadable
- * objects (if necessary)
- */
ScmObj
-scm_s_use(ScmObj feature, ScmObj env)
-{
- struct module_info *mod;
- ScmObj feature_str;
- const char *c_feature_str;
- DECLARE_FUNCTION("use", syntax_fixed_1);
-
- ENSURE_SYMBOL(feature);
-
- c_feature_str = SCM_SYMBOL_NAME(feature);
-
- for (mod = module_info_table; mod->name; mod++) {
- if (strcmp(c_feature_str, mod->name) == 0) {
- feature_str = CONST_STRING(c_feature_str);
- if (!scm_providedp(feature_str)) {
- (*mod->initializer)();
- scm_provide(feature_str);
- }
- return SCM_TRUE;
- }
- }
-
- return SCM_FALSE;
-}
-
-ScmObj
scm_eval_c_string(const char *exp)
{
#if !SCM_GCC4_READY_GC
@@ -427,348 +281,3 @@
}
free(argv);
}
-
-/*===========================================================================
- Scheme Function Export Related Functions
-===========================================================================*/
-static scm_bool
-scm_register_func(const char *name, ScmFuncType c_func,
- enum ScmFuncTypeCode type)
-{
- ScmObj sym, func;
-
- sym = scm_intern(name);
- func = MAKE_FUNC(type, c_func);
-
- /* TODO: reject bad TYPE */
- SCM_SYMBOL_SET_VCELL(sym, func);
- return scm_true;
-}
-
-/* Not implemented yet. */
-void scm_register_reduction_operator(const char *name, ScmObj (*func)(ScmObj, ScmObj, enum ScmReductionState*))
-{
- scm_register_func(name, func, SCM_REDUCTION_OPERATOR);
-}
-
-/* So, yeah, um... this isn't really such a big deal if you think
- * about W32.... */
-void scm_register_syntax_fixed_0(const char *name, ScmObj (*func)(ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED | 0);
-}
-
-#if SCM_FUNCTYPE_MAND_MAX >= 1
-void scm_register_syntax_fixed_1(const char *name, ScmObj (*func)(ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED | 1);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 2
-void scm_register_syntax_fixed_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED | 2);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 3
-void scm_register_syntax_fixed_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED | 3);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 4
-void scm_register_syntax_fixed_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED | 4);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 5
-void scm_register_syntax_fixed_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED | 5);
-}
-#endif
-
-void scm_register_syntax_fixed_tailrec_0(const char *name, ScmObj (*func)(ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 0);
-}
-
-#if SCM_FUNCTYPE_MAND_MAX >= 1
-void scm_register_syntax_fixed_tailrec_1(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 1);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 2
-void scm_register_syntax_fixed_tailrec_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 2);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 3
-void scm_register_syntax_fixed_tailrec_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 3);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 4
-void scm_register_syntax_fixed_tailrec_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 4);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 5
-void scm_register_syntax_fixed_tailrec_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_FIXED_TAIL_REC | 5);
-}
-#endif
-
-void scm_register_syntax_variadic_0(const char *name, ScmObj (*func)(ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 0);
-}
-
-#if SCM_FUNCTYPE_MAND_MAX >= 1
-void scm_register_syntax_variadic_1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 1);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 2
-void scm_register_syntax_variadic_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 2);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 3
-void scm_register_syntax_variadic_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 3);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 4
-void scm_register_syntax_variadic_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 4);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 5
-void scm_register_syntax_variadic_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC | 5);
-}
-#endif
-
-void scm_register_syntax_variadic_tailrec_0(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 0);
-}
-
-#if SCM_FUNCTYPE_MAND_MAX >= 1
-void scm_register_syntax_variadic_tailrec_1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 1);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 2
-void scm_register_syntax_variadic_tailrec_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 2);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 3
-void scm_register_syntax_variadic_tailrec_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 3);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 4
-void scm_register_syntax_variadic_tailrec_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 4);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 5
-void scm_register_syntax_variadic_tailrec_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_SYNTAX_VARIADIC_TAIL_REC | 5);
-}
-#endif
-
-void scm_register_procedure_fixed_0(const char *name, ScmObj (*func)())
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED | 0);
-}
-
-#if SCM_FUNCTYPE_MAND_MAX >= 1
-void scm_register_procedure_fixed_1(const char *name, ScmObj (*func)(ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED | 1);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 2
-void scm_register_procedure_fixed_2(const char *name, ScmObj (*func)(ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED | 2);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 3
-void scm_register_procedure_fixed_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED | 3);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 4
-void scm_register_procedure_fixed_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED | 4);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 5
-void scm_register_procedure_fixed_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED | 5);
-}
-#endif
-
-void scm_register_procedure_fixed_tailrec_0(const char *name, ScmObj (*func)(ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 0);
-}
-
-#if SCM_FUNCTYPE_MAND_MAX >= 1
-void scm_register_procedure_fixed_tailrec_1(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 1);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 2
-void scm_register_procedure_fixed_tailrec_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 2);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 3
-void scm_register_procedure_fixed_tailrec_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 3);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 4
-void scm_register_procedure_fixed_tailrec_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 4);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 5
-void scm_register_procedure_fixed_tailrec_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_FIXED_TAIL_REC | 5);
-}
-#endif
-
-void scm_register_procedure_variadic_0(const char *name, ScmObj (*func)(ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 0);
-}
-
-#if SCM_FUNCTYPE_MAND_MAX >= 1
-void scm_register_procedure_variadic_1(const char *name, ScmObj (*func)(ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 1);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 2
-void scm_register_procedure_variadic_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 2);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 3
-void scm_register_procedure_variadic_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 3);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 4
-void scm_register_procedure_variadic_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 4);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 5
-void scm_register_procedure_variadic_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC | 5);
-}
-#endif
-
-void scm_register_procedure_variadic_tailrec_0(const char *name, ScmObj (*func)(ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 0);
-}
-
-#if SCM_FUNCTYPE_MAND_MAX >= 1
-void scm_register_procedure_variadic_tailrec_1(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 1);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 2
-void scm_register_procedure_variadic_tailrec_2(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 2);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 3
-void scm_register_procedure_variadic_tailrec_3(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 3);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 4
-void scm_register_procedure_variadic_tailrec_4(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 4);
-}
-#endif
-
-#if SCM_FUNCTYPE_MAND_MAX >= 5
-void scm_register_procedure_variadic_tailrec_5(const char *name, ScmObj (*func)(ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmObj, ScmEvalState*))
-{
- scm_register_func(name, func, SCM_PROCEDURE_VARIADIC_TAIL_REC | 5);
-}
-#endif
Modified: branches/r5rs/sigscheme/src/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.h 2006-01-29 22:05:11 UTC (rev 3024)
+++ branches/r5rs/sigscheme/src/sigscheme.h 2006-01-29 23:20:33 UTC (rev 3025)
@@ -953,16 +953,18 @@
/* sigscheme.c */
void scm_initialize(const ScmStorageConf *storage_conf);
void scm_finalize(void);
-void scm_define_alias(const char *newsym, const char *sym);
-void scm_provide(ScmObj feature);
-scm_bool scm_providedp(ScmObj feature);
-scm_bool scm_use(const char *feature);
-ScmObj scm_s_use(ScmObj feature, ScmObj env);
ScmObj scm_eval_c_string(const char *exp);
#if SCM_COMPAT_SIOD
ScmObj scm_return_value(void);
#endif
+/* module.c */
+void scm_provide(ScmObj feature);
+scm_bool scm_providedp(ScmObj feature);
+scm_bool scm_use(const char *feature);
+ScmObj scm_s_use(ScmObj feature, ScmObj env);
+void scm_define_alias(const char *newsym, const char *sym);
+
/* Procedure/Syntax Registration */
void scm_register_reduction_operator(const char *name, ScmObj (*func)(ScmObj, ScmObj, enum ScmReductionState*));
void scm_register_syntax_fixed_0(const char *name, ScmObj (*func)(ScmObj));
@@ -1331,7 +1333,7 @@
ScmObj scm_p_lengthstar(ScmObj lst);
#endif
-/* io.c */
+/* port.c */
ScmObj scm_make_shared_file_port(FILE *file, const char *aux_info,
enum ScmPortFlag flag);
int scm_port_close(ScmObj port);
@@ -1449,12 +1451,14 @@
ScmObj scm_p_srfi1_lengthplus(ScmObj lst);
ScmObj scm_p_srfi1_concatenate(ScmObj args);
#endif
+
#if SCM_USE_SRFI2
/* operations-srfi2.c */
void scm_initialize_srfi2(void);
ScmObj scm_s_srfi2_and_letstar(ScmObj claws, ScmObj body,
ScmEvalState *eval_state);
#endif
+
#if SCM_USE_SRFI6
/* operations-srfi6.c */
void scm_initialize_srfi6(void);
@@ -1462,17 +1466,20 @@
ScmObj scm_p_srfi6_open_output_string(void);
ScmObj scm_p_srfi6_get_output_string(ScmObj port);
#endif
+
#if SCM_USE_SRFI8
/* operations-srfi8.c */
void scm_initialize_srfi8(void);
ScmObj scm_s_srfi8_receive(ScmObj formals, ScmObj expr, ScmObj body,
ScmEvalState *eval_state);
#endif
+
#if SCM_USE_SRFI23
/* operations-srfi23.c */
void scm_initialize_srfi23(void);
ScmObj scm_p_srfi23_error(ScmObj reason, ScmObj args);
#endif
+
#if SCM_USE_SRFI34
/* operations-srfi34.c */
void scm_initialize_srfi34(void);
@@ -1481,11 +1488,13 @@
ScmEvalState *eval_state);
ScmObj scm_p_srfi34_raise(ScmObj obj);
#endif
+
#if SCM_USE_SRFI38
/* operations-srfi38.c */
void scm_initialize_srfi38(void);
ScmObj scm_p_srfi38_write_with_shared_structure(ScmObj obj, ScmObj args);
#endif
+
#if SCM_USE_SRFI60
/* operations-srfi60.c */
void scm_initialize_srfi60(void);
@@ -1499,6 +1508,7 @@
ScmObj scm_p_srfi60_bitwise_if(ScmObj mask, ScmObj n0, ScmObj n1);
ScmObj scm_p_srfi60_logtest(ScmObj j, ScmObj k);
#endif
+
#if SCM_COMPAT_SIOD
/* operations-siod.c */
void scm_initialize_siod(void);
Modified: branches/r5rs/sigscheme/src/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-01-29 22:05:11 UTC (rev 3024)
+++ branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-01-29 23:20:33 UTC (rev 3025)
@@ -61,10 +61,10 @@
/*=======================================
Variable Declarations
=======================================*/
-/* sigscheme.c */
+/* operations.c */
extern ScmCharCodec *scm_identifier_codec;
-/* io.c */
+/* port.c */
extern ScmObj scm_in;
extern ScmObj scm_out;
extern ScmObj scm_err;
@@ -533,6 +533,9 @@
ScmObj scm_prepare_port(ScmObj args, ScmObj default_port);
ScmCharPort *scm_make_char_port(ScmBytePort *bport);
+/* module.c */
+void scm_init_module(void);
+
/* sigscheme.c */
char **scm_interpret_argv(char **argv);
void scm_free_argv(char **argv);
Modified: branches/r5rs/sigscheme/src/syntax.c
===================================================================
--- branches/r5rs/sigscheme/src/syntax.c 2006-01-29 22:05:11 UTC (rev 3024)
+++ branches/r5rs/sigscheme/src/syntax.c 2006-01-29 23:20:33 UTC (rev 3025)
@@ -55,6 +55,9 @@
/*=======================================
Variable Declarations
=======================================*/
+ScmObj scm_sym_quote, scm_sym_quasiquote;
+ScmObj scm_sym_unquote, scm_sym_unquote_splicing;
+
static ScmObj sym_else, sym_yields;
#if SCM_STRICT_DEFINE_PLACEMENT
static ScmObj sym_define, sym_begin, syn_lambda;
@@ -81,6 +84,11 @@
{
SCM_REGISTER_FUNC_TABLE(scm_r5rs_syntax_func_info_table);
+ scm_sym_quote = scm_intern("quote");
+ scm_sym_quasiquote = scm_intern("quasiquote");
+ scm_sym_unquote = scm_intern("unquote");
+ scm_sym_unquote_splicing = scm_intern("unquote-splicing");
+
sym_else = scm_intern("else");
sym_yields = scm_intern("=>");
#if SCM_STRICT_DEFINE_PLACEMENT
More information about the uim-commit
mailing list