Author: yamakenz
Date: Sun Jul 22 15:23:06 2007
New Revision: 4784
Added:
sigscheme-trunk/src/module-srfi9.c
Modified:
sigscheme-trunk/NEWS
sigscheme-trunk/README
sigscheme-trunk/configure.in
sigscheme-trunk/lib/Makefile.am
sigscheme-trunk/lib/srfi-9.scm
sigscheme-trunk/src/Makefile.am
sigscheme-trunk/src/module.c
sigscheme-trunk/src/sigscheme.h
sigscheme-trunk/src/sigschemeinternal.h
Log:
* This commit add SRFI-9, but validation is not done yet
* src/sigscheme.h
- (scm_s_srfi9_define_record_type): New function decl
* src/sigschemeinternal.h
- (scm_initialize_srfi9): New function decl
* src/module-srfi9.c
- New file
- (ERRMSG_MISPLACED_RECORD_DEFINITION, SYMBOL_VALUE): New macro
- (l_proc_make_record_type; l_proc_record_constructor,
l_proc_record_predicate, l_proc_record_accessor, l_proc_record_modifier):
New static variable
- (scm_initialize_srfi9, scm_s_srfi9_define_record_type): New function
- (define_record_field): New static function
* src/module.c
- (module_info_table): Add SRFI-9 entry
* src/Makefile.am
- (FUNC_TABLES): Add functable-srfi9.c
- (libsscm_sources): Add module-srfi9.c
* lib/srfi-9.scm
- (define-record-type, define-record-field): Comment out and replaced by
module-srfi9.c
* lib/Makefile.am
- (dist_scmlib_DATA): Add srfi-9.scm
* configure.in
- Add --enable-srfi9
* README
* NEWS
- Update
Modified: sigscheme-trunk/NEWS
==============================================================================
--- sigscheme-trunk/NEWS (original)
+++ sigscheme-trunk/NEWS Sun Jul 22 15:23:06 2007
@@ -5,6 +5,8 @@
- SRFI-1 List Library (full featured)
+ - SRFI-9 Defining Record Types
+
- SRFI-55 require-extension
- SRFI-95 Sorting and Merging
Modified: sigscheme-trunk/README
==============================================================================
--- sigscheme-trunk/README (original)
+++ sigscheme-trunk/README Sun Jul 22 15:23:06 2007
@@ -32,6 +32,7 @@
- SRFI-2 : AND-LET*: an AND with local bindings, a guarded LET* special form
- SRFI-6 : Basic String Ports
- SRFI-8 : receive: Binding to multiple values
+ - SRFI-9 : Defining Record Types
- SRFI-22 : Running Scheme Scripts on Unix (partial)
- SRFI-23 : Error Reporting Mechanism
- SRFI-28 : Basic Format Strings
Modified: sigscheme-trunk/configure.in
==============================================================================
--- sigscheme-trunk/configure.in (original)
+++ sigscheme-trunk/configure.in Sun Jul 22 15:23:06 2007
@@ -491,6 +491,7 @@
use_srfi2=yes
use_srfi6=yes
use_srfi8=yes
+ use_srfi9=yes
use_srfi22=yes
use_srfi23=yes
use_srfi28=yes
@@ -510,6 +511,7 @@
use_srfi2=no
use_srfi6=no
use_srfi8=no
+ use_srfi9=no
use_srfi22=no
use_srfi23=no
use_srfi28=no
@@ -529,6 +531,7 @@
use_srfi2=no
use_srfi6=no
use_srfi8=no
+ use_srfi9=no
use_srfi22=no
use_srfi23=no
use_srfi28=no
@@ -548,6 +551,7 @@
use_srfi2=yes
use_srfi6=yes
use_srfi8=yes
+ use_srfi9=yes
use_srfi22=yes
use_srfi23=yes
use_srfi28=yes
@@ -659,6 +663,7 @@
AX_FEATURE_ARG_Y(srfi2, [SRFI-2 'and-let*'])
AX_FEATURE_ARG_Y(srfi6, [SRFI-6 basic string ports])
AX_FEATURE_ARG_Y(srfi8, [SRFI-8 'receive'])
+AX_FEATURE_ARG_Y(srfi9, [SRFI-9 defining record types])
AX_FEATURE_ARG_Y(srfi22, [SRFI-22 running scheme scripts on Unix
(partial)])
AX_FEATURE_ARG_Y(srfi23, [SRFI-23 'error'])
AX_FEATURE_ARG_Y(srfi28, [SRFI-28 'format'])
@@ -727,6 +732,7 @@
eval_c_string: reader srfi6
srfi1: continuation deep_cadrs load sscm_extensions srfi8 srfi23
srfi6: port string
+srfi9: load srfi23
srfi34: continuation srfi23
srfi38: writer
srfi55: load sscm_extensions
@@ -876,6 +882,7 @@
AX_FEATURE_DEFINE(srfi2)
AX_FEATURE_DEFINE(srfi6)
AX_FEATURE_DEFINE(srfi8)
+AX_FEATURE_DEFINE(srfi9)
AX_FEATURE_DEFINE(srfi22)
AX_FEATURE_DEFINE(srfi23)
AX_FEATURE_DEFINE(srfi28)
@@ -952,6 +959,7 @@
AC_SUBST(use_srfi2)
AC_SUBST(use_srfi6)
AC_SUBST(use_srfi8)
+AC_SUBST(use_srfi9)
AC_SUBST(use_srfi22)
AC_SUBST(use_srfi23)
AC_SUBST(use_srfi28)
@@ -1106,6 +1114,7 @@
SRFI-2: $use_srfi2
SRFI-6: $use_srfi6
SRFI-8: $use_srfi8
+SRFI-9: $use_srfi9
SRFI-22: $use_srfi22
SRFI-23: $use_srfi23
SRFI-28: $use_srfi28
Modified: sigscheme-trunk/lib/Makefile.am
==============================================================================
--- sigscheme-trunk/lib/Makefile.am (original)
+++ sigscheme-trunk/lib/Makefile.am Sun Jul 22 15:23:06 2007
@@ -1,4 +1,5 @@
-dist_scmlib_DATA = sigscheme-init.scm srfi-1.scm srfi-55.scm srfi-95.scm
+dist_scmlib_DATA = sigscheme-init.scm \
+ srfi-1.scm srfi-9.scm srfi-55.scm srfi-95.scm
# Install into master package's pkgdatadir if --with-master-pkg is specified
# e.g.)
Modified: sigscheme-trunk/lib/srfi-9.scm
==============================================================================
--- sigscheme-trunk/lib/srfi-9.scm (original)
+++ sigscheme-trunk/lib/srfi-9.scm Sun Jul 22 15:23:06 2007
@@ -20,6 +20,13 @@
;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+;; ChangeLog
+;;
+;; 2007-07-23 yamaken - Imported from
+;; http://srfi.schemers.org/srfi-9/srfi-9.html
+;; and adapted to SigScheme
+
+
;; This code is divided into three layers. In top-down order these are:
;;
;; 1. Syntax definitions for DEFINE-RECORD-TYPE and an auxillary macro.
@@ -39,33 +46,33 @@
; Definition of DEFINE-RECORD-TYPE
-(define-syntax define-record-type
- (syntax-rules ()
- ((define-record-type type
- (constructor constructor-tag ...)
- predicate
- (field-tag accessor . more) ...)
- (begin
- (define type
- (make-record-type 'type '(field-tag ...)))
- (define constructor
- (record-constructor type '(constructor-tag ...)))
- (define predicate
- (record-predicate type))
- (define-record-field type field-tag accessor . more)
- ...))))
+;;(define-syntax define-record-type
+;; (syntax-rules ()
+;; ((define-record-type type
+;; (constructor constructor-tag ...)
+;; predicate
+;; (field-tag accessor . more) ...)
+;; (begin
+;; (define type
+;; (make-record-type 'type '(field-tag ...)))
+;; (define constructor
+;; (record-constructor type '(constructor-tag ...)))
+;; (define predicate
+;; (record-predicate type))
+;; (define-record-field type field-tag accessor . more)
+;; ...))))
; An auxilliary macro for define field accessors and modifiers.
; This is needed only because modifiers are optional.
-(define-syntax define-record-field
- (syntax-rules ()
- ((define-record-field type field-tag accessor)
- (define accessor (record-accessor type 'field-tag)))
- ((define-record-field type field-tag accessor modifier)
- (begin
- (define accessor (record-accessor type 'field-tag))
- (define modifier (record-modifier type 'field-tag))))))
+;;(define-syntax define-record-field
+;; (syntax-rules ()
+;; ((define-record-field type field-tag accessor)
+;; (define accessor (record-accessor type 'field-tag)))
+;; ((define-record-field type field-tag accessor modifier)
+;; (begin
+;; (define accessor (record-accessor type 'field-tag))
+;; (define modifier (record-modifier type 'field-tag))))))
;;
Modified: sigscheme-trunk/src/Makefile.am
==============================================================================
--- sigscheme-trunk/src/Makefile.am (original)
+++ sigscheme-trunk/src/Makefile.am Sun Jul 22 15:23:06 2007
@@ -39,6 +39,7 @@
functable-srfi2.c \
functable-srfi6.c \
functable-srfi8.c \
+ functable-srfi9.c \
functable-srfi23.c \
functable-srfi28.c \
functable-srfi34.c \
@@ -101,6 +102,8 @@
$(BUILD_FUNCTBL_CMD) $@ "scm_functable_srfi6" $<
functable-srfi8.c: module-srfi8.c $(BUILD_FUNCTBL_DEPS)
$(BUILD_FUNCTBL_CMD) $@ "scm_functable_srfi8" $<
+functable-srfi9.c: module-srfi9.c $(BUILD_FUNCTBL_DEPS)
+ $(BUILD_FUNCTBL_CMD) $@ "scm_functable_srfi9" $<
functable-srfi23.c: module-srfi23.c $(BUILD_FUNCTBL_DEPS)
$(BUILD_FUNCTBL_CMD) $@ "scm_functable_srfi23" $<
functable-srfi28.c: module-srfi28.c $(BUILD_FUNCTBL_DEPS)
@@ -318,6 +321,9 @@
endif
if USE_SRFI8
libsscm_sources += module-srfi8.c
+endif
+if USE_SRFI9
+ libsscm_sources += module-srfi9.c
endif
if USE_SRFI23
libsscm_sources += module-srfi23.c
Added: sigscheme-trunk/src/module-srfi9.c
==============================================================================
--- (empty file)
+++ sigscheme-trunk/src/module-srfi9.c Sun Jul 22 15:23:06 2007
@@ -0,0 +1,165 @@
+/*===========================================================================
+ * Filename : module-srfi9.c
+ * About : SRFI-9 Defining Record Types
+ *
+ * Copyright (c) 2007 SigScheme Project <uim-en AT googlegroups.com>
+ *
+ * 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.
+===========================================================================*/
+
+#include <config.h>
+
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+ File Local Macro Definitions
+=======================================*/
+#define ERRMSG_MISPLACED_RECORD_DEFINITION \
+ "record type definition is not allowed here"
+
+#define SYMBOL_VALUE(sym) \
+ (scm_symbol_value(scm_intern(sym), SCM_INTERACTION_ENV))
+
+/*=======================================
+ File Local Type Definitions
+=======================================*/
+static void define_record_field(ScmObj type_obj, ScmObj field_spec,
+ ScmObj env);
+
+/*=======================================
+ Variable Definitions
+=======================================*/
+#include "functable-srfi9.c"
+
+SCM_GLOBAL_VARS_BEGIN(static_srfi9);
+#define static
+static ScmObj l_proc_make_record_type;
+static ScmObj l_proc_record_constructor, l_proc_record_predicate;
+static ScmObj l_proc_record_accessor, l_proc_record_modifier;
+#undef static
+SCM_GLOBAL_VARS_END(static_srfi9);
+#define l_proc_make_record_type SCM_GLOBAL_VAR(static_srfi9, \
+ l_proc_make_record_type)
+#define l_proc_record_constructor SCM_GLOBAL_VAR(static_srfi9, \
+ l_proc_record_constructor)
+#define l_proc_record_predicate SCM_GLOBAL_VAR(static_srfi9, \
+ l_proc_record_predicate)
+#define l_proc_record_accessor SCM_GLOBAL_VAR(static_srfi9, \
+ l_proc_record_accessor)
+#define l_proc_record_modifier SCM_GLOBAL_VAR(static_srfi9, \
+ l_proc_record_modifier)
+SCM_DEFINE_STATIC_VARS(static_srfi9);
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+
+/*=======================================
+ Function Definitions
+=======================================*/
+SCM_EXPORT void
+scm_initialize_srfi9(void)
+{
+ SCM_GLOBAL_VARS_INIT(static_srfi9);
+
+ scm_register_funcs(scm_functable_srfi9);
+
+ scm_require_module("srfi-23");
+ scm_load_system_file("srfi-9.scm");
+
+ l_proc_make_record_type = SYMBOL_VALUE("make-record-type");
+ l_proc_record_constructor = SYMBOL_VALUE("record-constructor");
+ l_proc_record_predicate = SYMBOL_VALUE("record-predicate");
+ l_proc_record_accessor = SYMBOL_VALUE("record-accessor");
+ l_proc_record_modifier = SYMBOL_VALUE("record-modifier");
+}
+
+SCM_EXPORT ScmObj
+scm_s_srfi9_define_record_type(ScmObj type_name, ScmObj ctor_spec,
+ ScmObj pred_name, ScmObj field_specs,
+ ScmEvalState *eval_state)
+{
+ ScmObj env, type_obj, ctor, pred, ctor_name, field_tags, field_spec, rest;
+ DECLARE_FUNCTION("define-record-type", syntax_variadic_tailrec_3);
+
+ if (!SCM_DEFINABLE_TOPLEVELP(eval_state))
+ ERR(ERRMSG_MISPLACED_RECORD_DEFINITION);
+
+ ENSURE_SYMBOL(type_name);
+ ENSURE_CONS(ctor_spec);
+ ENSURE_SYMBOL(pred_name);
+
+ env = eval_state->env;
+
+ ctor_name = CAR(ctor_spec);
+ field_tags = CDR(ctor_spec);
+
+ type_obj = scm_call(l_proc_make_record_type,
+ LIST_2(type_name, field_tags));
+ ctor = scm_call(l_proc_record_constructor, LIST_2(type_obj, field_tags));
+ pred = scm_call(l_proc_record_predicate, LIST_1(type_obj));
+ scm_s_define_internal(ScmFirstClassObj,
+ type_name, LIST_2(SYM_QUOTE, type_obj), env);
+ scm_s_define_internal(ScmFirstClassObj, ctor_name, ctor, env);
+ scm_s_define_internal(ScmFirstClassObj, pred_name, pred, env);
+
+ rest = field_specs;
+ FOR_EACH (field_spec, rest)
+ define_record_field(type_obj, field_spec, env);
+ ENSURE_PROPER_LIST_TERMINATION(rest, field_specs);
+
+ return SCM_UNDEF;
+}
+
+/* define-record-field is not a part of SRFI-9. */
+static void
+define_record_field(ScmObj type_obj, ScmObj field_spec, ScmObj env)
+{
+ ScmObj field_tag, accessor_name, modifier_name, accessor, modifier, rest;
+ DECLARE_INTERNAL_FUNCTION("define-record-type");
+
+ rest = field_spec;
+ field_tag = MUST_POP_ARG(rest);
+ accessor_name = MUST_POP_ARG(rest);
+ ENSURE_SYMBOL(field_tag);
+ ENSURE_SYMBOL(accessor_name);
+
+ accessor = scm_call(l_proc_record_accessor, LIST_2(type_obj, field_tag));
+ scm_s_define_internal(ScmFirstClassObj, accessor_name, accessor, env);
+
+ if (!NO_MORE_ARG(rest)) {
+ modifier_name = POP(rest);
+ ENSURE_SYMBOL(modifier_name);
+
+ modifier = scm_call(l_proc_record_modifier,
+ LIST_2(type_obj, field_tag));
+ scm_s_define_internal(ScmFirstClassObj, modifier_name, modifier, env);
+ }
+ ENSURE_PROPER_LIST_TERMINATION(rest, field_spec);
+}
Modified: sigscheme-trunk/src/module.c
==============================================================================
--- sigscheme-trunk/src/module.c (original)
+++ sigscheme-trunk/src/module.c Sun Jul 22 15:23:06 2007
@@ -86,6 +86,9 @@
#if SCM_USE_SRFI8
{"srfi-8", scm_initialize_srfi8, NULL},
#endif
+#if SCM_USE_SRFI9
+ {"srfi-9", scm_initialize_srfi9, NULL},
+#endif
#if SCM_USE_SRFI23
{"srfi-23", scm_initialize_srfi23, NULL},
#endif
Modified: sigscheme-trunk/src/sigscheme.h
==============================================================================
--- sigscheme-trunk/src/sigscheme.h (original)
+++ sigscheme-trunk/src/sigscheme.h Sun Jul 22 15:23:06 2007
@@ -1711,6 +1711,15 @@
ScmEvalState *eval_state);
#endif
+/* module-srfi9.c */
+#if SCM_USE_SRFI9
+SCM_EXPORT ScmObj scm_s_srfi9_define_record_type(ScmObj type_name,
+ ScmObj ctor_spec,
+ ScmObj pred_name,
+ ScmObj field_specs,
+ ScmEvalState *eval_state);
+#endif
+
/* module-srfi23.c */
#if SCM_USE_SRFI23
SCM_EXPORT ScmObj scm_p_srfi23_error(ScmObj reason, ScmObj args);
Modified: sigscheme-trunk/src/sigschemeinternal.h
==============================================================================
--- sigscheme-trunk/src/sigschemeinternal.h (original)
+++ sigscheme-trunk/src/sigschemeinternal.h Sun Jul 22 15:23:06 2007
@@ -816,6 +816,11 @@
SCM_EXPORT void scm_initialize_srfi8(void);
#endif
+/* module-srfi9.c */
+#if SCM_USE_SRFI9
+SCM_EXPORT void scm_initialize_srfi9(void);
+#endif
+
/* module-srfi23.c */
#if SCM_USE_SRFI23
SCM_EXPORT void scm_initialize_srfi23(void);
