[uim-commit] r2996 - in branches/r5rs/sigscheme: . doc src test
yamaken at freedesktop.org
yamaken at freedesktop.org
Thu Jan 26 00:31:35 PST 2006
Author: yamaken
Date: 2006-01-26 00:31:23 -0800 (Thu, 26 Jan 2006)
New Revision: 2996
Modified:
branches/r5rs/sigscheme/NEWS
branches/r5rs/sigscheme/doc/spec.txt
branches/r5rs/sigscheme/src/config.h
branches/r5rs/sigscheme/src/operations.c
branches/r5rs/sigscheme/src/read.c
branches/r5rs/sigscheme/src/sigscheme.c
branches/r5rs/sigscheme/src/sigscheme.h
branches/r5rs/sigscheme/src/sigschemeinternal.h
branches/r5rs/sigscheme/src/storage-fatty.h
branches/r5rs/sigscheme/src/storage.c
branches/r5rs/sigscheme/test/test-vector.scm
Log:
* sigscheme/src/config.h
- (SCM_CONST_VECTOR_LITERAL): New macro
* sigscheme/src/sigscheme.h
- (SCM_MAKE_IMMUTABLE_VECTOR, SCM_VECTOR_MUTABLEP,
SCM_VECTOR_SET_MUTABLE, SCM_VECTOR_SET_IMMUTABLE): New macro
* sigscheme/src/sigschemeinternal.h
- (MAKE_IMMUTABLE_VECTOR, ENSURE_MUTABLE_VECTOR): New macro
* sigscheme/src/storage-fatty.h
- (SCM_SAL_MAKE_IMMUTABLE_VECTOR, SCM_SAL_VECTOR_MUTABLEP,
SCM_SAL_VECTOR_SET_MUTABLE, SCM_SAL_VECTOR_SET_IMMUTABLE): New
macro
- (scm_make_immutable_vector): New function decl
* sigscheme/src/storage.c
- (scm_make_immutable_vector): New function
- (scm_make_vector): Support constant vector literal
* sigscheme/src/read.c
- (read_sexpression): Ditto
* sigscheme/src/operations.c
- (scm_p_vector_setd, scm_p_vector_filld): Ditto
* sigscheme/src/sigscheme.c
- (scm_initialize_internal): Provide const-vector-literal when
SCM_CONST_VECTOR_LITERAL
* sigscheme/test/test-vector.scm
- Add tests for const vector literal
* sigscheme/doc/spec.txt
- Update "Constant vector" and "Quote-less vector literal"
* sigscheme/NEWS
- Update
Modified: branches/r5rs/sigscheme/NEWS
===================================================================
--- branches/r5rs/sigscheme/NEWS 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/NEWS 2006-01-26 08:31:23 UTC (rev 2996)
@@ -8,6 +8,10 @@
- Add lacking string predicates and complete all R5RS string procedures
+ - Support constant vector (storage-compact is not yet)
+
+ - Add quote-less vector literal check
+
* Fixes
- Make behavior of internal definitions strictly conforming to R5RS
Modified: branches/r5rs/sigscheme/doc/spec.txt
===================================================================
--- branches/r5rs/sigscheme/doc/spec.txt 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/doc/spec.txt 2006-01-26 08:31:23 UTC (rev 2996)
@@ -108,8 +108,8 @@
- Constant vector
- SigScheme allows modification of constant vector object for convenience
- although it is required to be an error in R5RS.
+ SigScheme allows modification of constant vector object by default for
+ convenience although it is required to be an error in R5RS.
> 6.3.6 Vectors
>
@@ -121,6 +121,9 @@
The object is modified as #(0 "doe" 2) in SigScheme. Gauche and Guile are
also behaves so.
+ The behavior can be configured to R5RS-compatible with
+ SCM_CONST_VECTOR_LITERAL
+
- Quote-less null list
SigScheme allows quote-less null list by default for convenience and
@@ -139,10 +142,13 @@
- Quote-less vector literal
- Sigscheme allows quote-less vector literal for convenience, although
- quotation is required in formal R5RS syntax. This specification may be
- changed to make notation rule consistent with constant list.
+ Sigscheme allows quote-less vector literal by default for convenience,
+ although quotation is required in formal R5RS syntax. This specification
+ may be changed to make notation rule consistent with constant list.
+ The behavior can be configured to R5RS-compatible with
+ SCM_STRICT_VECTOR_FORM
+
> 6.3.6 Vectors
>
> Vectors are written using the notation #(obj ...). For example, a vector
Modified: branches/r5rs/sigscheme/src/config.h
===================================================================
--- branches/r5rs/sigscheme/src/config.h 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/src/config.h 2006-01-26 08:31:23 UTC (rev 2996)
@@ -86,6 +86,7 @@
#define SCM_STRICT_ARGCHECK 1 /* enable strict argument check */
#define SCM_STRICT_DEFINE_PLACEMENT 1 /* enable strict check on internal definitions */
#define SCM_STRICT_ENCODING_CHECK 1 /* do all feasible encoding error checks */
+#define SCM_CONST_VECTOR_LITERAL 0 /* parse vector literal as const */
#define SCM_ACCESSOR_ASSERT 0 /* enable strict type check with accessor */
#define SCM_USE_VALUECONS 1 /* use experimental values passing */
#define SCM_VOLATILE_OUTPUT 0 /* always flush files on write */
Modified: branches/r5rs/sigscheme/src/operations.c
===================================================================
--- branches/r5rs/sigscheme/src/operations.c 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/src/operations.c 2006-01-26 08:31:23 UTC (rev 2996)
@@ -2093,6 +2093,9 @@
DECLARE_FUNCTION("vector-set!", procedure_fixed_3);
ENSURE_VECTOR(vec);
+#if SCM_CONST_VECTOR_LITERAL
+ ENSURE_MUTABLE_VECTOR(vec);
+#endif
ENSURE_INT(scm_k);
k = SCM_INT_VALUE(scm_k);
@@ -2152,6 +2155,9 @@
DECLARE_FUNCTION("vector-fill!", procedure_fixed_2);
ENSURE_VECTOR(vec);
+#if SCM_CONST_VECTOR_LITERAL
+ ENSURE_MUTABLE_VECTOR(vec);
+#endif
v = SCM_VECTOR_VEC(vec);
len = SCM_VECTOR_LEN(vec);
Modified: branches/r5rs/sigscheme/src/read.c
===================================================================
--- branches/r5rs/sigscheme/src/read.c 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/src/read.c 2006-01-26 08:31:23 UTC (rev 2996)
@@ -263,6 +263,7 @@
static ScmObj
read_sexpression(ScmObj port)
{
+ ScmObj ret;
scm_ichar_t c;
CDBG((SCM_DBG_PARSER, "read_sexpression"));
@@ -295,7 +296,11 @@
case 'f':
return SCM_FALSE;
case '(':
- return scm_p_list2vector(read_list(port, ')'));
+ ret = scm_p_list2vector(read_list(port, ')'));
+#if SCM_CONST_VECTOR_LITERAL
+ SCM_VECTOR_SET_IMMUTABLE(ret);
+#endif
+ return ret;
case '\\':
return read_char(port);
case 'b': case 'o': case 'd': case 'x':
Modified: branches/r5rs/sigscheme/src/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.c 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/src/sigscheme.c 2006-01-26 08:31:23 UTC (rev 2996)
@@ -194,6 +194,9 @@
#if SCM_STRICT_ARGCHECK
scm_provide(CONST_STRING("strict-argcheck"));
#endif
+#if SCM_CONST_VECTOR_LITERAL
+ scm_provide(CONST_STRING("const-vector-literal"));
+#endif
#if SCM_COMPAT_SIOD_BUGS
scm_provide(CONST_STRING("siod-bugs"));
#endif
Modified: branches/r5rs/sigscheme/src/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.h 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/src/sigscheme.h 2006-01-26 08:31:23 UTC (rev 2996)
@@ -711,6 +711,8 @@
#define SCM_MAKE_CLOSURE(exp, env) SCM_SAL_MAKE_CLOSURE((exp), (env))
/* SCM_MAKE_VECTOR(ScmObj *vec, scm_int_t len) */
#define SCM_MAKE_VECTOR(vec, len) SCM_SAL_MAKE_VECTOR((vec), (len))
+#define SCM_MAKE_IMMUTABLE_VECTOR(vec, len) \
+ SCM_SAL_MAKE_IMMUTABLE_VECTOR((vec), (len))
#define SCM_MAKE_PORT(cport, flag) SCM_SAL_MAKE_PORT((cport), (flag))
#define SCM_MAKE_CONTINUATION() SCM_SAL_MAKE_CONTINUATION()
#if SCM_USE_NONSTD_FEATURES
@@ -802,6 +804,9 @@
#define SCM_VECTOR_LEN(o) SCM_SAL_VECTOR_LEN(o)
#define SCM_VECTOR_SET_VEC(o, vec) SCM_SAL_VECTOR_SET_VEC((o), (vec))
#define SCM_VECTOR_SET_LEN(o, len) SCM_SAL_VECTOR_SET_LEN((o), (len))
+#define SCM_VECTOR_MUTABLEP(o) SCM_SAL_VECTOR_MUTABLEP(o)
+#define SCM_VECTOR_SET_MUTABLE(o) SCM_SAL_VECTOR_SET_MUTABLE(o)
+#define SCM_VECTOR_SET_IMMUTABLE(o) SCM_SAL_VECTOR_SET_IMMUTABLE(o)
#define SCM_VECTOR_VALID_INDEXP(o, i) SCM_SAL_VECTOR_VALID_INDEXP((o), (i))
#define SCM_PORTP(o) SCM_SAL_PORTP(o)
Modified: branches/r5rs/sigscheme/src/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-01-26 08:31:23 UTC (rev 2996)
@@ -185,6 +185,7 @@
#define MAKE_FUNC SCM_MAKE_FUNC
#define MAKE_CLOSURE SCM_MAKE_CLOSURE
#define MAKE_VECTOR SCM_MAKE_VECTOR
+#define MAKE_IMMUTABLE_VECTOR SCM_MAKE_IMMUTABLE_VECTOR
#define MAKE_PORT SCM_MAKE_PORT
#define MAKE_CONTINUATION SCM_MAKE_CONTINUATION
#if SCM_USE_NONSTD_FEATURES
@@ -352,6 +353,10 @@
(SCM_STRING_MUTABLEP(str) \
|| (ERR_OBJ("attempted to modify immutable string", str), 1))
+#define ENSURE_MUTABLE_VECTOR(vec) \
+ (SCM_VECTOR_MUTABLEP(vec) \
+ || (ERR_OBJ("attempted to modify immutable vector", vec), 1))
+
#define ENSURE_STATEFUL_CODEC(codec) \
(SCM_CHARCODEC_STATEFULP(codec) \
|| (ERR("%s: stateful character codec required but got: %s", \
Modified: branches/r5rs/sigscheme/src/storage-fatty.h
===================================================================
--- branches/r5rs/sigscheme/src/storage-fatty.h 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/src/storage-fatty.h 2006-01-26 08:31:23 UTC (rev 2996)
@@ -217,6 +217,7 @@
#define SCM_SAL_MAKE_FUNC scm_make_func
#define SCM_SAL_MAKE_CLOSURE scm_make_closure
#define SCM_SAL_MAKE_VECTOR scm_make_vector
+#define SCM_SAL_MAKE_IMMUTABLE_VECTOR scm_make_immutable_vector
#define SCM_SAL_MAKE_PORT scm_make_port
#define SCM_SAL_MAKE_CONTINUATION scm_make_continuation
#if SCM_USE_NONSTD_FEATURES
@@ -243,6 +244,7 @@
ScmObj scm_make_func(enum ScmFuncTypeCode type, ScmFuncType func);
ScmObj scm_make_closure(ScmObj exp, ScmObj env);
ScmObj scm_make_vector(ScmObj *vec, scm_int_t len);
+ScmObj scm_make_immutable_vector(ScmObj *vec, scm_int_t len);
ScmObj scm_make_port(ScmCharPort *cport, enum ScmPortFlag flag);
ScmObj scm_make_continuation(void);
#if !SCM_USE_VALUECONS
@@ -327,6 +329,9 @@
#define SCM_SAL_VECTOR_SET_VEC(o, vec) (SCM_VECTOR_VEC(o) = (vec))
#define SCM_SAL_VECTOR_LEN(o) (SCM_AS_VECTOR(o)->obj.vector.len)
#define SCM_SAL_VECTOR_SET_LEN(o, len) (SCM_VECTOR_LEN(o) = (len))
+#define SCM_SAL_VECTOR_MUTABLEP(o) (SCM_MUTABLEP(o))
+#define SCM_SAL_VECTOR_SET_MUTABLE(o) (SCM_SET_MUTABLE(o))
+#define SCM_SAL_VECTOR_SET_IMMUTABLE(o) (SCM_SET_IMMUTABLE(o))
#define SCM_SAL_VECTOR_VALID_INDEXP(o, i) (0 <= (i) && (i) < SCM_VECTOR_LEN(o))
#define SCM_SAL_PORTP(o) (SCM_TYPE(o) == ScmPort)
Modified: branches/r5rs/sigscheme/src/storage.c
===================================================================
--- branches/r5rs/sigscheme/src/storage.c 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/src/storage.c 2006-01-26 08:31:23 UTC (rev 2996)
@@ -292,11 +292,24 @@
SCM_ENTYPE_VECTOR(obj);
SCM_VECTOR_SET_VEC(obj, vec);
SCM_VECTOR_SET_LEN(obj, len);
+ SCM_VECTOR_SET_MUTABLE(obj);
return obj;
}
ScmObj
+scm_make_immutable_vector(ScmObj *vec, scm_int_t len)
+{
+ ScmObj obj;
+
+ /* Since this function is rarely used, the inefficiency is not problem */
+ obj = scm_make_vector(vec, len);
+ SCM_VECTOR_SET_IMMUTABLE(obj);
+
+ return obj;
+}
+
+ScmObj
scm_make_port(ScmCharPort *cport, enum ScmPortFlag flag)
{
ScmObj obj;
Modified: branches/r5rs/sigscheme/test/test-vector.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-vector.scm 2006-01-26 07:19:49 UTC (rev 2995)
+++ branches/r5rs/sigscheme/test/test-vector.scm 2006-01-26 08:31:23 UTC (rev 2996)
@@ -32,6 +32,8 @@
(load "./test/unittest.scm")
+(define tn test-name)
+
;; vector
(assert-equal? "vector test" '#() (vector))
(assert-equal? "vector test" '#(a) (vector 'a))
@@ -66,30 +68,66 @@
(vector-ref '#() 1)))
;; vector-set!
-(assert-equal? "vector-set! test"
+(tn "vector-set!")
+(assert-equal? (tn)
'#(#t a "abc" #f ())
(begin
(define tmpvec (vector 1 'a "abc" #f '()))
(vector-set! tmpvec 0 #t)
tmpvec))
-(assert-equal? "vector-set! test"
+(assert-equal? (tn)
'#(1 a #t #f ())
(begin
(define tmpvec (vector 1 'a "abc" #f '()))
(vector-set! tmpvec 2 #t)
tmpvec))
-(assert-equal? "vector-set! test"
+(assert-equal? (tn)
'#(1 a "abc" #f #t)
(begin
(define tmpvec (vector 1 'a "abc" #f '()))
(vector-set! tmpvec 4 #t)
tmpvec))
-(assert-error "vector-set! test"
+(assert-error (tn)
(lambda ()
(vector-set! '#() -1 #t)))
-(assert-error "vector-set! test"
+(assert-error (tn)
(lambda ()
(vector-set! '#() 1 #t)))
+(tn "vector-set! const vector")
+(if (and (provided? "sigscheme")
+ (provided? "const-vector-literal"))
+ (begin
+ (assert-error (tn)
+ (lambda ()
+ (define tmpvec '#(1 'a "abc" #f '()))
+ (vector-set! tmpvec 0 #t)))
+ (assert-error (tn)
+ (lambda ()
+ (define tmpvec '#(1 'a "abc" #f '()))
+ (vector-set! tmpvec 2 #t)))
+ (assert-error (tn)
+ (lambda ()
+ (define tmpvec '#(1 'a "abc" #f '()))
+ (vector-set! tmpvec 4 #t))))
+ (begin
+ (assert-equal? (tn)
+ '#(#t a "abc" #f ())
+ (begin
+ (define tmpvec '#(1 'a "abc" #f '()))
+ (vector-set! tmpvec 0 #t)
+ tmpvec))
+ (assert-equal? (tn)
+ '#(1 a #t #f ())
+ (begin
+ (define tmpvec '#(1 'a "abc" #f '()))
+ (vector-set! tmpvec 2 #t)
+ tmpvec))
+ (assert-equal? (tn)
+ '#(1 a "abc" #f #t)
+ (begin
+ (define tmpvec '#(1 'a "abc" #f '()))
+ (vector-set! tmpvec 4 #t)
+ tmpvec))))
;; vector->list
(assert-equal? "vector->list test" '() (vector->list '#()))
@@ -102,17 +140,43 @@
(assert-equal? "list->vector test" '#(a b) (list->vector '(a b)))
;; vector-fill!
-(assert-equal? "vector-fill! test"
+(tn "vector-fill!")
+(assert-equal? (tn)
'#()
(begin
(define tmpvec (vector))
(vector-fill! tmpvec #f)
tmpvec))
-(assert-equal? "vector-fill! test"
+(assert-equal? (tn)
'#(#f #f #f #f)
(begin
(define tmpvec (vector #t #t #t #t))
(vector-fill! tmpvec #f)
tmpvec))
+(tn "vector-fill! const vector")
+(if (and (provided? "sigscheme")
+ (provided? "const-vector-literal"))
+ (begin
+ (assert-error (tn)
+ (lambda ()
+ (define tmpvec '#())
+ (vector-fill! tmpvec #f)))
+ (assert-error (tn)
+ (lambda ()
+ (define tmpvec '#(#t #t #t #t))
+ (vector-fill! tmpvec #f))))
+ (begin
+ (assert-equal? (tn)
+ '#()
+ (begin
+ (define tmpvec '#())
+ (vector-fill! tmpvec #f)
+ tmpvec))
+ (assert-equal? (tn)
+ '#(#f #f #f #f)
+ (begin
+ (define tmpvec '#(#t #t #t #t))
+ (vector-fill! tmpvec #f)
+ tmpvec))))
(total-report)
More information about the uim-commit
mailing list