Author: yamakenz
Date: Mon Aug 27 09:48:18 2007
New Revision: 4906
Added:
sigscheme-trunk/lib/srfi-43.scm
- copied, changed from r4905, /vendor/misc/vector-lib.scm
sigscheme-trunk/src/module-srfi43.c
Modified:
sigscheme-trunk/COPYING
sigscheme-trunk/NEWS
sigscheme-trunk/QALog
sigscheme-trunk/README
sigscheme-trunk/RELNOTE
sigscheme-trunk/configure.in
sigscheme-trunk/lib/Makefile.am
sigscheme-trunk/src/Makefile.am
sigscheme-trunk/src/module.c
sigscheme-trunk/src/sigschemeinternal.h
Log:
* This commit add SRFI-43. Basically working, but not tested yet
* src/sigschemeinternal.h
- (scm_initialize_srfi43): New function decl
* src/module-srfi43.c
- New file
- (scm_initialize_srfi43, scm_s_let_vector_start_plus_end): New function
- (QUOTE): New macro
- (l_sym_vector_parse_start_plus_end, l_sym_check_type, l_sym_vectorp): New
static variable
* src/module.c
- (module_info_table): Add srfi-43
* src/Makefile.am
- Add generation rule for functable-srfi43.c
- (FUNC_TABLES): Add functable-srfi43.c
- (libsscm_sources): Add module-srfi43.c
* lib/srfi-43.scm
- New file copied from vendor/misc/vector-lib.scm
- Adapted to SigScheme
- (receive, let*-optionals, let*-optionals:aux, let-vector-start+end):
Comment out
* lib/Makefile.am
- (dist_scmlib_DATA): Add srfi-43.scm
* configure.in
- Add --enable-srfi43
- Add lacking 'vector' dependency of srfi9
* COPYING
* QALog
* README
* NEWS
* RELNOTE
- Update
Modified: sigscheme-trunk/COPYING
==============================================================================
--- sigscheme-trunk/COPYING (original)
+++ sigscheme-trunk/COPYING Mon Aug 27 09:48:18 2007
@@ -95,6 +95,12 @@
-----------------------------------------------------------------------------
+lib/srfi-43.scm is covered by:
+-----------------------------------------------------------------------------
+;;; Taylor Campbell wrote this code; he places it in the public domain.
+-----------------------------------------------------------------------------
+
+
lib/srfi-69.scm is covered by:
-----------------------------------------------------------------------------
Copyright (C) Panu Kalliokoski (2005). All Rights Reserved.
Modified: sigscheme-trunk/NEWS
==============================================================================
--- sigscheme-trunk/NEWS (original)
+++ sigscheme-trunk/NEWS Mon Aug 27 09:48:18 2007
@@ -7,6 +7,8 @@
- SRFI-9 Defining Record Types
+ - SRFI-43 Vector library
+
- SRFI-55 require-extension
- SRFI-69 Basic hash tables
Modified: sigscheme-trunk/QALog
==============================================================================
--- sigscheme-trunk/QALog (original)
+++ sigscheme-trunk/QALog Mon Aug 27 09:48:18 2007
@@ -179,6 +179,7 @@
* module-srfi28.c
* module-srfi34.c
* module-srfi38.c
+ * module-srfi43.c
* module-srfi48.c
* module-srfi55.c
* module-srfi60.c
@@ -277,6 +278,7 @@
yyyy yyy srfi module-srfi28.c
yyyy yyy srfi module-srfi34.c
yyyy yyy srfi module-srfi38.c
+ srfi module-srfi43.c
yyyy yyy srfi module-srfi48.c
yyyy yy srfi module-srfi55.c
yyyyyyyy srfi module-srfi60.c
@@ -1017,6 +1019,17 @@
coding style: [EMAIL PROTECTED]
normal case tests: [EMAIL PROTECTED]
corner case tests: [EMAIL PROTECTED]
+
+file: module-srfi43.c
+category: srfi
+spec by eyes:
+spec by tests:
+general review:
+64-bit by eyes:
+64-bit by tests:
+coding style:
+normal case tests:
+corner case tests:
file: module-srfi48.c
category: srfi
Modified: sigscheme-trunk/README
==============================================================================
--- sigscheme-trunk/README (original)
+++ sigscheme-trunk/README Mon Aug 27 09:48:18 2007
@@ -38,6 +38,7 @@
- SRFI-28 : Basic Format Strings
- SRFI-34 : Exception Handling for Programs
- SRFI-38 : External Representation for Data with Shared Structure (partial)
+ - SRFI-43 : Vector library
- SRFI-48 : Intermediate Format Strings
- SRFI-55 : require-extension
- SRFI-60 : Integer as Bits (partial)
Modified: sigscheme-trunk/RELNOTE
==============================================================================
--- sigscheme-trunk/RELNOTE (original)
+++ sigscheme-trunk/RELNOTE Mon Aug 27 09:48:18 2007
@@ -53,6 +53,7 @@
- SRFI-1 List Library (full-featured)
- SRFI-9 Defining Record Types
+ - SRFI-43 Vector library
- SRFI-55 require-extension
- SRFI-69 Basic hash tables
- SRFI-95 Sorting and Merging
Modified: sigscheme-trunk/configure.in
==============================================================================
--- sigscheme-trunk/configure.in (original)
+++ sigscheme-trunk/configure.in Mon Aug 27 09:48:18 2007
@@ -498,6 +498,7 @@
use_srfi28=yes
use_srfi34=yes
use_srfi38=yes
+ use_srfi43=yes
use_srfi48=yes
use_srfi55=yes
use_srfi60=yes
@@ -515,6 +516,7 @@
use_srfi28=no
use_srfi34=no
use_srfi38=no
+ use_srfi43=no
use_srfi48=no
use_srfi55=no
use_srfi60=no
@@ -660,6 +662,7 @@
AX_FEATURE_ARG_Y(srfi28, [SRFI-28 'format'])
AX_FEATURE_ARG_Y(srfi34, [SRFI-34 exception handling for programs])
AX_FEATURE_ARG_Y(srfi38, [SRFI-38 'write/ss' ('read/ss' is not
provided)])
+AX_FEATURE_ARG_Y(srfi43, [SRFI-43 vector library])
AX_FEATURE_ARG_Y(srfi48, [SRFI-48 'format' (superset of SRFI-28)])
AX_FEATURE_ARG_Y(srfi55, [SRFI-55 'require-extension'])
AX_FEATURE_ARG_Y(srfi60, [SRFI-60 integers as bits (partial)])
@@ -725,9 +728,10 @@
eval_c_string: reader srfi6
srfi1: continuation deep_cadrs load sscm_extensions srfi8 srfi23
srfi6: port string
-srfi9: load srfi23
+srfi9: load vector srfi23
srfi34: continuation srfi23
srfi38: writer
+srfi43: load vector srfi8 srfi23 sscm_extensions
srfi55: load sscm_extensions
srfi60: int
srfi69: load int string vector srfi9 srfi23
@@ -884,6 +888,7 @@
AX_FEATURE_DEFINE(srfi28)
AX_FEATURE_DEFINE(srfi34)
AX_FEATURE_DEFINE(srfi38)
+AX_FEATURE_DEFINE(srfi43)
AX_FEATURE_DEFINE(srfi48)
AX_FEATURE_DEFINE(srfi55)
AX_FEATURE_DEFINE(srfi60)
@@ -963,6 +968,7 @@
AC_SUBST(use_srfi28)
AC_SUBST(use_srfi34)
AC_SUBST(use_srfi38)
+AC_SUBST(use_srfi43)
AC_SUBST(use_srfi48)
AC_SUBST(use_srfi55)
AC_SUBST(use_srfi60)
@@ -1121,6 +1127,7 @@
SRFI-28: $use_srfi28
SRFI-34: $use_srfi34
SRFI-38: $use_srfi38
+SRFI-43: $use_srfi43
SRFI-48: $use_srfi48
SRFI-55: $use_srfi55
SRFI-60: $use_srfi60
Modified: sigscheme-trunk/lib/Makefile.am
==============================================================================
--- sigscheme-trunk/lib/Makefile.am (original)
+++ sigscheme-trunk/lib/Makefile.am Mon Aug 27 09:48:18 2007
@@ -5,6 +5,9 @@
if USE_SRFI9
dist_scmlib_DATA += srfi-9.scm
endif
+if USE_SRFI43
+dist_scmlib_DATA += srfi-43.scm
+endif
if USE_SRFI55
dist_scmlib_DATA += srfi-55.scm
endif
Copied: sigscheme-trunk/lib/srfi-43.scm (from r4905,
/vendor/misc/vector-lib.scm)
==============================================================================
--- /vendor/misc/vector-lib.scm (original)
+++ sigscheme-trunk/lib/srfi-43.scm Mon Aug 27 09:48:18 2007
@@ -2,6 +2,14 @@
;;; Taylor Campbell wrote this code; he places it in the public domain.
+
+;; ChangeLog
+;;
+;; 2007-08-28 yamaken - Imported from
+;; http://srfi.schemers.org/srfi-43/vector-lib.scm
+;; and adapted to SigScheme
+
+
;;; --------------------
;;; Exported procedure index
;;;
@@ -78,41 +86,43 @@
;;; --------------------
;;; Utilities
-;;; SRFI 8, too trivial to put in the dependencies list.
-(define-syntax receive
- (syntax-rules ()
- ((receive ?formals ?producer ?body1 ?body2 ...)
- (call-with-values (lambda () ?producer)
- (lambda ?formals ?body1 ?body2 ...)))))
-
-;;; Not the best LET*-OPTIONALS, but not the worst, either. Use Olin's
-;;; if it's available to you.
-(define-syntax let*-optionals
- (syntax-rules ()
- ((let*-optionals (?x ...) ((?var ?default) ...) ?body1 ?body2 ...)
- (let ((args (?x ...)))
- (let*-optionals args ((?var ?default) ...) ?body1 ?body2 ...)))
- ((let*-optionals ?args ((?var ?default) ...) ?body1 ?body2 ...)
- (let*-optionals:aux ?args ?args ((?var ?default) ...)
- ?body1 ?body2 ...))))
-
-(define-syntax let*-optionals:aux
- (syntax-rules ()
- ((aux ?orig-args-var ?args-var () ?body1 ?body2 ...)
- (if (null? ?args-var)
- (let () ?body1 ?body2 ...)
- (error "too many arguments" (length ?orig-args-var)
- ?orig-args-var)))
- ((aux ?orig-args-var ?args-var
- ((?var ?default) ?more ...)
- ?body1 ?body2 ...)
- (if (null? ?args-var)
- (let* ((?var ?default) ?more ...) ?body1 ?body2 ...)
- (let ((?var (car ?args-var))
- (new-args (cdr ?args-var)))
- (let*-optionals:aux ?orig-args-var new-args
- (?more ...)
- ?body1 ?body2 ...))))))
+;;; SigScheme: Use native SRFI-8
+;;;;; SRFI 8, too trivial to put in the dependencies list.
+;;(define-syntax receive
+;; (syntax-rules ()
+;; ((receive ?formals ?producer ?body1 ?body2 ...)
+;; (call-with-values (lambda () ?producer)
+;; (lambda ?formals ?body1 ?body2 ...)))))
+
+;;; SigScheme: Define let*-optionals as an alias to let-optionals*
+;;;;; Not the best LET*-OPTIONALS, but not the worst, either. Use Olin's
+;;;;; if it's available to you.
+;;(define-syntax let*-optionals
+;; (syntax-rules ()
+;; ((let*-optionals (?x ...) ((?var ?default) ...) ?body1 ?body2 ...)
+;; (let ((args (?x ...)))
+;; (let*-optionals args ((?var ?default) ...) ?body1 ?body2 ...)))
+;; ((let*-optionals ?args ((?var ?default) ...) ?body1 ?body2 ...)
+;; (let*-optionals:aux ?args ?args ((?var ?default) ...)
+;; ?body1 ?body2 ...))))
+;;
+;;(define-syntax let*-optionals:aux
+;; (syntax-rules ()
+;; ((aux ?orig-args-var ?args-var () ?body1 ?body2 ...)
+;; (if (null? ?args-var)
+;; (let () ?body1 ?body2 ...)
+;; (error "too many arguments" (length ?orig-args-var)
+;; ?orig-args-var)))
+;; ((aux ?orig-args-var ?args-var
+;; ((?var ?default) ?more ...)
+;; ?body1 ?body2 ...)
+;; (if (null? ?args-var)
+;; (let* ((?var ?default) ?more ...) ?body1 ?body2 ...)
+;; (let ((?var (car ?args-var))
+;; (new-args (cdr ?args-var)))
+;; (let*-optionals:aux ?orig-args-var new-args
+;; (?more ...)
+;; ?body1 ?body2 ...))))))
(define (nonneg-int? x)
(and (integer? x)
@@ -286,15 +296,16 @@
`(extra args were ,(cddr args))
`(while calling ,callee))))))
-(define-syntax let-vector-start+end
- (syntax-rules ()
- ((let-vector-start+end ?callee ?vec ?args (?start ?end)
- ?body1 ?body2 ...)
- (let ((?vec (check-type vector? ?vec ?callee)))
- (receive (?start ?end)
- (vector-parse-start+end ?vec ?args '?start '?end
- ?callee)
- ?body1 ?body2 ...)))))
+;;; SigScheme: Defined in module-srfi43.c
+;;(define-syntax let-vector-start+end
+;; (syntax-rules ()
+;; ((let-vector-start+end ?callee ?vec ?args (?start ?end)
+;; ?body1 ?body2 ...)
+;; (let ((?vec (check-type vector? ?vec ?callee)))
+;; (receive (?start ?end)
+;; (vector-parse-start+end ?vec ?args '?start '?end
+;; ?callee)
+;; ?body1 ?body2 ...)))))
;;; (%SMALLEST-LENGTH <vector-list> <default-length> <callee>)
;;; -> exact, nonnegative integer
Modified: sigscheme-trunk/src/Makefile.am
==============================================================================
--- sigscheme-trunk/src/Makefile.am (original)
+++ sigscheme-trunk/src/Makefile.am Mon Aug 27 09:48:18 2007
@@ -45,6 +45,7 @@
functable-srfi28.c \
functable-srfi34.c \
functable-srfi38.c \
+ functable-srfi43.c \
functable-srfi48.c \
functable-srfi55.c \
functable-srfi60.c
@@ -115,6 +116,8 @@
$(BUILD_FUNCTBL_CMD) $@ "scm_functable_srfi34" $<
functable-srfi38.c: module-srfi38.c $(BUILD_FUNCTBL_DEPS)
$(BUILD_FUNCTBL_CMD) $@ "scm_functable_srfi38" $<
+functable-srfi43.c: module-srfi43.c $(BUILD_FUNCTBL_DEPS)
+ $(BUILD_FUNCTBL_CMD) $@ "scm_functable_srfi43" $<
functable-srfi48.c: module-srfi48.c $(BUILD_FUNCTBL_DEPS)
$(BUILD_FUNCTBL_CMD) $@ "scm_functable_srfi48" $<
functable-srfi55.c: module-srfi55.c $(BUILD_FUNCTBL_DEPS)
@@ -341,6 +344,9 @@
endif
if USE_SRFI38
libsscm_sources += module-srfi38.c
+endif
+if USE_SRFI43
+ libsscm_sources += module-srfi43.c
endif
if USE_SRFI48
libsscm_sources += module-srfi48.c
Added: sigscheme-trunk/src/module-srfi43.c
==============================================================================
--- (empty file)
+++ sigscheme-trunk/src/module-srfi43.c Mon Aug 27 09:48:18 2007
@@ -0,0 +1,125 @@
+/*===========================================================================
+ * Filename : module-srfi43.c
+ * About : SRFI-43 Vector library
+ *
+ * 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 QUOTE(obj) (LIST_2(SYM_QUOTE, (obj)))
+
+/*=======================================
+ File Local Type Definitions
+=======================================*/
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+SCM_EXPORT ScmObj scm_s_let_vector_start_plus_end(ScmObj callee, ScmObj vec,
+ ScmObj args,
+ ScmObj start_plus_end,
+ ScmObj body,
+ ScmEvalState *eval_state);
+
+/*=======================================
+ Variable Definitions
+=======================================*/
+#include "functable-srfi43.c"
+
+SCM_GLOBAL_VARS_BEGIN(static_srfi43);
+#define static
+static ScmObj l_sym_vector_parse_start_plus_end;
+static ScmObj l_sym_check_type, l_sym_vectorp;
+#undef static
+SCM_GLOBAL_VARS_END(static_srfi43);
+#define l_sym_vector_parse_start_plus_end \
+ SCM_GLOBAL_VAR(static_srfi43, l_sym_vector_parse_start_plus_end)
+#define l_sym_check_type SCM_GLOBAL_VAR(static_srfi43, l_sym_check_type)
+#define l_sym_vectorp SCM_GLOBAL_VAR(static_srfi43, l_sym_vectorp)
+SCM_DEFINE_STATIC_VARS(static_srfi43);
+
+/*=======================================
+ Function Definitions
+=======================================*/
+SCM_EXPORT void
+scm_initialize_srfi43(void)
+{
+ SCM_GLOBAL_VARS_INIT(static_srfi43);
+
+ scm_register_funcs(scm_functable_srfi43);
+
+ scm_require_module("srfi-8");
+ scm_require_module("srfi-23");
+ scm_require_module("sscm-ext"); /* for let-optionals* */
+ scm_load_system_file("srfi-43.scm");
+
+ l_sym_vector_parse_start_plus_end = scm_intern("vector-parse-start+end");
+ l_sym_check_type = scm_intern("check-type");
+ l_sym_vectorp = scm_intern("vector?");
+
+ scm_define_alias("let*-optionals", "let-optionals*");
+}
+
+/* let-vector-start+end is not a part of SRFI-43. */
+SCM_EXPORT ScmObj
+scm_s_let_vector_start_plus_end(ScmObj callee, ScmObj vec,
+ ScmObj args, ScmObj start_plus_end,
+ ScmObj body,
+ ScmEvalState *eval_state)
+{
+ ScmObj env, start, end, proc_check_type, check_type_args, receive_expr;
+ DECLARE_FUNCTION("let-vector-start+end", syntax_variadic_tailrec_4);
+
+ if (!LIST_2_P(start_plus_end))
+ ERR_OBJ("invalid start+end form", start_plus_end);
+ /* The responsibility of type checks for other args are delegated to
+ * 'check-type' and 'receive'. */
+
+ env = eval_state->env;
+
+ proc_check_type = EVAL(l_sym_check_type, env);
+ check_type_args = LIST_3(EVAL(l_sym_vectorp, env),
+ EVAL(vec, env),
+ EVAL(callee, env));
+ vec = scm_call(proc_check_type, check_type_args);
+
+ start = QUOTE(CAR(start_plus_end));
+ end = QUOTE(CADR(start_plus_end));
+ receive_expr = CONS(l_sym_vector_parse_start_plus_end,
+ LIST_5(QUOTE(vec), args, start, end, callee));
+ return scm_s_srfi8_receive(start_plus_end, receive_expr, body, eval_state);
+}
Modified: sigscheme-trunk/src/module.c
==============================================================================
--- sigscheme-trunk/src/module.c (original)
+++ sigscheme-trunk/src/module.c Mon Aug 27 09:48:18 2007
@@ -101,6 +101,9 @@
#if SCM_USE_SRFI38
{"srfi-38", scm_initialize_srfi38, NULL},
#endif
+#if SCM_USE_SRFI43
+ {"srfi-43", scm_initialize_srfi43, NULL},
+#endif
#if SCM_USE_SRFI48
{"srfi-48", scm_initialize_srfi48, NULL},
#endif
Modified: sigscheme-trunk/src/sigschemeinternal.h
==============================================================================
--- sigscheme-trunk/src/sigschemeinternal.h (original)
+++ sigscheme-trunk/src/sigschemeinternal.h Mon Aug 27 09:48:18 2007
@@ -833,6 +833,11 @@
SCM_EXPORT void scm_initialize_srfi38(void);
#endif
+/* module-srfi43.c */
+#if SCM_USE_SRFI43
+SCM_EXPORT void scm_initialize_srfi43(void);
+#endif
+
/* module-srfi48.c */
#if SCM_USE_SRFI48
SCM_EXPORT void scm_initialize_srfi48(void);
