[uim-commit] r3002 - branches/r5rs/sigscheme/src
yamaken at freedesktop.org
yamaken at freedesktop.org
Fri Jan 27 01:50:31 PST 2006
Author: yamaken
Date: 2006-01-27 01:50:26 -0800 (Fri, 27 Jan 2006)
New Revision: 3002
Modified:
branches/r5rs/sigscheme/src/config.h
branches/r5rs/sigscheme/src/operations-srfi1.c
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-compact.h
branches/r5rs/sigscheme/src/storage-fatty.h
branches/r5rs/sigscheme/src/storage.c
Log:
* sigscheme/src/config.h
- (SCM_STRICT_VECTOR_FORM, SCM_CONST_VECTOR_LITERAL): Enable by
default
- (SCM_CONST_LIST_LITERAL): New macro
* sigscheme/src/sigscheme.h
- (SCM_IMMUTABLE_CONS, SCM_HAS_IMMUTABLE_CONS,
SCM_HAS_IMMUTABLE_STRING, SCM_HAS_IMMUTABLE_VECTOR,
SCM_MAKE_IMMUTABLE_CONS, SCM_CONS_MUTABLEP, SCM_CONS_SET_MUTABLE,
SCM_CONS_SET_IMMUTABLE): New macro
* sigscheme/src/sigschemeinternal.h
- (IMMUTABLE_CONS, MAKE_IMMUTABLE_CONS, ENSURE_MUTABLE_CONS,
SCM_QUEUE_CONST_ADD): New macro
* sigscheme/src/storage-fatty.h
- (SCM_SAL_HAS_IMMUTABLE_CONS, SCM_SAL_HAS_IMMUTABLE_STRING,
SCM_SAL_HAS_IMMUTABLE_VECTOR, SCM_SAL_MAKE_IMMUTABLE_CONS,
SCM_SAL_CONS_MUTABLEP, SCM_SAL_CONS_SET_MUTABLE,
SCM_SAL_CONS_SET_IMMUTABLE): New macro
- (scm_make_immutable_cons): New function decl
* sigscheme/src/storage-compact.h
- (SCM_SAL_HAS_IMMUTABLE_CONS, SCM_SAL_HAS_IMMUTABLE_STRING,
SCM_SAL_HAS_IMMUTABLE_VECTOR, SCM_SAL_MAKE_IMMUTABLE_CONS,
SCM_SAL_MAKE_IMMUTABLE_VECTOR, SCM_SAL_CONS_MUTABLEP,
SCM_SAL_CONS_SET_MUTABLE, SCM_SAL_CONS_SET_IMMUTABLE): New macro
- (scm_make_immutable_cons, scm_make_immutable_vector): New function
decl
* sigscheme/src/storage.c
- (scm_make_cons): Support constant list
- (scm_make_immutable_cons): New function
* sigscheme/src/read.c
- (read_list): Support constant list
* sigscheme/src/operations.c
- (scm_p_set_card, scm_p_set_cdrd): Ditto
* sigscheme/src/operations-srfi1.c
- (scm_p_srfi1_taked, scm_p_srfi1_drop_rightd): Ditto
* sigscheme/src/sigscheme.c
- (scm_initialize_internal):
* Provide "const-list-literal" if SCM_CONST_LIST_LITERAL
* Provide "const-vector-literal" only if SCM_HAS_IMMUTABLE_VECTOR
Modified: branches/r5rs/sigscheme/src/config.h
===================================================================
--- branches/r5rs/sigscheme/src/config.h 2006-01-27 08:34:29 UTC (rev 3001)
+++ branches/r5rs/sigscheme/src/config.h 2006-01-27 09:50:26 UTC (rev 3002)
@@ -82,11 +82,12 @@
===========================================================================*/
#define SCM_STRICT_R5RS 0 /* use strict R5RS check */
#define SCM_STRICT_NULL_FORM 0 /* disallow quote-less () */
-#define SCM_STRICT_VECTOR_FORM 0 /* disallow quote-less vector literal */
+#define SCM_STRICT_VECTOR_FORM 1 /* disallow quote-less vector literal */
#define SCM_STRICT_ARGCHECK 1 /* enable strict argument check */
-#define SCM_STRICT_DEFINE_PLACEMENT 1 /* enable strict check on internal definitions */
+#define SCM_STRICT_DEFINE_PLACEMENT 1 /* reject invalid 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_CONST_LIST_LITERAL 1 /* make list literal immutable */
+#define SCM_CONST_VECTOR_LITERAL 1 /* make vector literal immutable */
#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-srfi1.c
===================================================================
--- branches/r5rs/sigscheme/src/operations-srfi1.c 2006-01-27 08:34:29 UTC (rev 3001)
+++ branches/r5rs/sigscheme/src/operations-srfi1.c 2006-01-27 09:50:26 UTC (rev 3002)
@@ -516,6 +516,7 @@
tmp = CDR(tmp);
}
+ ENSURE_MUTABLE_CONS(tmp);
SET_CDR(tmp, SCM_NULL);
return lst;
@@ -541,6 +542,7 @@
tmp = CDR(tmp);
}
+ ENSURE_MUTABLE_CONS(tmp);
SET_CDR(tmp, SCM_NULL);
return lst;
Modified: branches/r5rs/sigscheme/src/operations.c
===================================================================
--- branches/r5rs/sigscheme/src/operations.c 2006-01-27 08:34:29 UTC (rev 3001)
+++ branches/r5rs/sigscheme/src/operations.c 2006-01-27 09:50:26 UTC (rev 3002)
@@ -763,6 +763,7 @@
DECLARE_FUNCTION("set-car!", procedure_fixed_2);
ENSURE_CONS(pair);
+ ENSURE_MUTABLE_CONS(pair);
SET_CAR(pair, car);
@@ -779,6 +780,7 @@
DECLARE_FUNCTION("set-cdr!", procedure_fixed_2);
ENSURE_CONS(pair);
+ ENSURE_MUTABLE_CONS(pair);
SET_CDR(pair, cdr);
Modified: branches/r5rs/sigscheme/src/read.c
===================================================================
--- branches/r5rs/sigscheme/src/read.c 2006-01-27 08:34:29 UTC (rev 3001)
+++ branches/r5rs/sigscheme/src/read.c 2006-01-27 09:50:26 UTC (rev 3002)
@@ -366,7 +366,15 @@
SCM_PORT_IMPL(port));
start_line = (basecport) ? ScmBaseCharPort_line_number(basecport) : -1;
- for (lst = SCM_NULL, SCM_QUEUE_POINT_TO(q, lst);; SCM_QUEUE_ADD(q, elm)) {
+ for (lst = SCM_NULL, SCM_QUEUE_POINT_TO(q, lst);
+ ;
+#if SCM_CONST_LIST_LITERAL
+ SCM_QUEUE_CONST_ADD(q, elm)
+#else
+ SCM_QUEUE_ADD(q, elm)
+#endif
+ )
+ {
c = skip_comment_and_space(port);
CDBG((SCM_DBG_PARSER, "read_list c = [%c]", (int)c));
Modified: branches/r5rs/sigscheme/src/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.c 2006-01-27 08:34:29 UTC (rev 3001)
+++ branches/r5rs/sigscheme/src/sigscheme.c 2006-01-27 09:50:26 UTC (rev 3002)
@@ -194,7 +194,10 @@
#if SCM_STRICT_ARGCHECK
scm_provide(CONST_STRING("strict-argcheck"));
#endif
-#if SCM_CONST_VECTOR_LITERAL
+#if (SCM_CONST_LIST_LITERAL && SCM_HAS_IMMUTABLE_CONS)
+ scm_provide(CONST_STRING("const-list-literal"));
+#endif
+#if (SCM_CONST_VECTOR_LITERAL && SCM_HAS_IMMUTABLE_VECTOR)
scm_provide(CONST_STRING("const-vector-literal"));
#endif
#if SCM_COMPAT_SIOD_BUGS
Modified: branches/r5rs/sigscheme/src/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.h 2006-01-27 08:34:29 UTC (rev 3001)
+++ branches/r5rs/sigscheme/src/sigscheme.h 2006-01-27 09:50:26 UTC (rev 3002)
@@ -134,7 +134,8 @@
#define SCM_SYMBOL_BOUNDP(sym) (!SCM_EQ(SCM_SYMBOL_VCELL(sym), SCM_UNBOUND))
-#define SCM_CONS(kar, kdr) (SCM_MAKE_CONS((kar), (kdr)))
+#define SCM_CONS(kar, kdr) (SCM_MAKE_CONS((kar), (kdr)))
+#define SCM_IMMUTABLE_CONS(kar, kdr) (SCM_MAKE_IMMUTABLE_CONS((kar), (kdr)))
#define SCM_CAR(kons) (SCM_CONS_CAR(kons))
#define SCM_CDR(kons) (SCM_CONS_CDR(kons))
#define SCM_CAAR(kons) (SCM_CAR(SCM_CAR(kons)))
@@ -656,6 +657,10 @@
#define SCM_HAS_STRING SCM_SAL_HAS_STRING
#define SCM_HAS_VECTOR SCM_SAL_HAS_VECTOR
+#define SCM_HAS_IMMUTABLE_CONS SCM_SAL_HAS_IMMUTABLE_CONS
+#define SCM_HAS_IMMUTABLE_STRING SCM_SAL_HAS_IMMUTABLE_STRING
+#define SCM_HAS_IMMUTABLE_VECTOR SCM_SAL_HAS_IMMUTABLE_VECTOR
+
/* for optimization */
#define SCM_HAS_IMMEDIATE_CHAR_ONLY SCM_SAL_HAS_IMMEDIATE_CHAR
#define SCM_HAS_IMMEDIATE_NUMBER_ONLY SCM_SAL_HAS_IMMEDIATE_NUMBER_ONLY
@@ -691,6 +696,8 @@
#define SCM_MAKE_BOOL(x) ((x) ? SCM_TRUE : SCM_FALSE)
#define SCM_MAKE_INT(val) SCM_SAL_MAKE_INT(val)
#define SCM_MAKE_CONS(kar, kdr) SCM_SAL_MAKE_CONS((kar), (kdr))
+#define SCM_MAKE_IMMUTABLE_CONS(kar, kdr) \
+ SCM_SAL_MAKE_IMMUTABLE_CONS((kar), (kdr))
#define SCM_MAKE_SYMBOL(name, val) SCM_SAL_MAKE_SYMBOL((name), (val))
#define SCM_MAKE_CHAR(val) SCM_SAL_MAKE_CHAR(val)
@@ -761,6 +768,9 @@
#define SCM_CONS_CDR(o) SCM_SAL_CONS_CDR(o)
#define SCM_CONS_SET_CAR(o, kar) SCM_SAL_CONS_SET_CAR((o), (kar))
#define SCM_CONS_SET_CDR(o, kdr) SCM_SAL_CONS_SET_CDR((o), (kdr))
+#define SCM_CONS_MUTABLEP(o) SCM_SAL_CONS_MUTABLEP(o)
+#define SCM_CONS_SET_MUTABLE(o) SCM_SAL_CONS_SET_MUTABLE(o)
+#define SCM_CONS_SET_IMMUTABLE(o) SCM_SAL_CONS_SET_IMMUTABLE(o)
#define SCM_SYMBOLP(o) SCM_SAL_SYMBOLP(o)
#define SCM_SYMBOL_NAME(o) SCM_SAL_SYMBOL_NAME(o)
Modified: branches/r5rs/sigscheme/src/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-01-27 08:34:29 UTC (rev 3001)
+++ branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-01-27 09:50:26 UTC (rev 3002)
@@ -155,6 +155,7 @@
#define CDDR SCM_CDDR
#define CONS SCM_CONS
+#define IMMUTABLE_CONS SCM_IMMUTABLE_CONS
#define LIST_1 SCM_LIST_1
#define LIST_2 SCM_LIST_2
#define LIST_3 SCM_LIST_3
@@ -172,6 +173,7 @@
#define MAKE_BOOL SCM_MAKE_BOOL
#define MAKE_INT SCM_MAKE_INT
#define MAKE_CONS SCM_MAKE_CONS
+#define MAKE_IMMUTABLE_CONS SCM_MAKE_IMMUTABLE_CONS
#define MAKE_SYMBOL SCM_MAKE_SYMBOL
#define MAKE_CHAR SCM_MAKE_CHAR
@@ -349,6 +351,10 @@
#define ENSURE_ERROBJ(obj) ENSURE_TYPE(ERROBJP, "error object", (obj))
#define ENSURE_LIST(obj) ENSURE_TYPE(LISTP, "list", (obj))
+#define ENSURE_MUTABLE_CONS(kons) \
+ (SCM_CONS_MUTABLEP(kons) \
+ || (ERR_OBJ("attempted to modify immutable pair", kons), 1))
+
#define ENSURE_MUTABLE_STRING(str) \
(SCM_STRING_MUTABLEP(str) \
|| (ERR_OBJ("attempted to modify immutable string", str), 1))
@@ -388,6 +394,9 @@
#define SCM_QUEUE_POINT_TO(_q, _out) ((_q) = SCM_REF_OFF_HEAP(_out))
#define SCM_QUEUE_ADD(_q, _dat) (SET((_q), LIST_1(_dat)), \
(_q) = REF_CDR(DEREF(_q)))
+#define SCM_QUEUE_CONST_ADD(_q, _dat) \
+ (SET((_q), IMMUTABLE_CONS((_dat), SCM_NULL)), \
+ (_q) = REF_CDR(DEREF(_q)))
#define SCM_QUEUE_APPEND(_q, _lst) \
do { \
SET((_q), (_lst)); \
Modified: branches/r5rs/sigscheme/src/storage-compact.h
===================================================================
--- branches/r5rs/sigscheme/src/storage-compact.h 2006-01-27 08:34:29 UTC (rev 3001)
+++ branches/r5rs/sigscheme/src/storage-compact.h 2006-01-27 09:50:26 UTC (rev 3002)
@@ -666,6 +666,10 @@
#define SCM_SAL_HAS_STRING 1
#define SCM_SAL_HAS_VECTOR 1
+#define SCM_SAL_HAS_IMMUTABLE_CONS 0
+#define SCM_SAL_HAS_IMMUTABLE_STRING 1
+#define SCM_SAL_HAS_IMMUTABLE_VECTOR 0 /* FIXME: implement immutable vector */
+
/* for optimization */
#define SCM_SAL_HAS_IMMEDIATE_CHAR_ONLY 1
#define SCM_SAL_HAS_IMMEDIATE_NUMBER_ONLY 1
@@ -696,6 +700,7 @@
=======================================*/
#define SCM_SAL_MAKE_INT scm_make_int
#define SCM_SAL_MAKE_CONS scm_make_cons
+#define SCM_SAL_MAKE_IMMUTABLE_CONS scm_make_immutable_cons
#define SCM_SAL_MAKE_SYMBOL scm_make_symbol
#define SCM_SAL_MAKE_CHAR scm_make_char
#define SCM_SAL_MAKE_STRING scm_make_string
@@ -705,6 +710,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
@@ -716,6 +722,7 @@
/* Don't use these functions directly. Use SCM_MAKE_*() or MAKE_*() instead to
* allow flexible object allocation. */
ScmObj scm_make_cons(ScmObj kar, ScmObj kdr);
+ScmObj scm_make_immutable_cons(ScmObj kar, ScmObj kdr);
#if 1
/* FIXME: directly create by SCM_SAL_MAKE_*() */
ScmObj scm_make_int(scm_int_t val);
@@ -729,6 +736,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
@@ -823,6 +831,9 @@
#define SCM_SAL_CONS_CDR(a) ((ScmObj)(SCM_CONS_CDR_VAL(a)))
#define SCM_SAL_CONS_SET_CAR(a, val) SCM_CONS_SET_CAR_VAL((a), (val))
#define SCM_SAL_CONS_SET_CDR(a, val) SCM_CONS_SET_CDR_VAL((a), (val))
+#define SCM_SAL_CONS_MUTABLEP(o) (SCM_FALSE)
+#define SCM_SAL_CONS_SET_MUTABLE(o)
+#define SCM_SAL_CONS_SET_IMMUTABLE(o)
/*==============================================================================
Accessors For Scheme Objects : Closure
@@ -941,6 +952,10 @@
SCM_OTHERS_SET_CDR_VAL((a), VECTOR, (val))
#define SCM_SAL_VECTOR_VALID_INDEXP(o, i) (0 <= (i) && (i) < SCM_VECTOR_LEN(o))
+#define SCM_SAL_VECTOR_MUTABLEP(o) /* FIXME */
+#define SCM_SAL_VECTOR_SET_MUTABLE(o) /* FIXME */
+#define SCM_SAL_VECTOR_SET_IMMUTABLE(o) /* FIXME */
+
/*
* ValuePacket
*/
Modified: branches/r5rs/sigscheme/src/storage-fatty.h
===================================================================
--- branches/r5rs/sigscheme/src/storage-fatty.h 2006-01-27 08:34:29 UTC (rev 3001)
+++ branches/r5rs/sigscheme/src/storage-fatty.h 2006-01-27 09:50:26 UTC (rev 3002)
@@ -178,6 +178,10 @@
#define SCM_SAL_HAS_STRING 1
#define SCM_SAL_HAS_VECTOR 1
+#define SCM_SAL_HAS_IMMUTABLE_CONS 1
+#define SCM_SAL_HAS_IMMUTABLE_STRING 1
+#define SCM_SAL_HAS_IMMUTABLE_VECTOR 1
+
/* for optimization */
#define SCM_SAL_HAS_IMMEDIATE_CHAR_ONLY 0
#define SCM_SAL_HAS_IMMEDIATE_NUMBER_ONLY 0
@@ -208,6 +212,7 @@
=======================================*/
#define SCM_SAL_MAKE_INT scm_make_int
#define SCM_SAL_MAKE_CONS scm_make_cons
+#define SCM_SAL_MAKE_IMMUTABLE_CONS scm_make_immutable_cons
#define SCM_SAL_MAKE_SYMBOL scm_make_symbol
#define SCM_SAL_MAKE_CHAR scm_make_char
#define SCM_SAL_MAKE_STRING scm_make_string
@@ -234,6 +239,7 @@
/* Don't use these functions directly. Use SCM_MAKE_*() or MAKE_*() instead to
* allow flexible object allocation. */
ScmObj scm_make_cons(ScmObj kar, ScmObj kdr);
+ScmObj scm_make_immutable_cons(ScmObj kar, ScmObj kdr);
ScmObj scm_make_int(scm_int_t val);
ScmObj scm_make_symbol(char *name, ScmObj val);
ScmObj scm_make_char(scm_ichar_t val);
@@ -285,6 +291,9 @@
#endif /* SCM_DEBUG */
#define SCM_SAL_CONS_SET_CAR(o, kar) (SCM_AS_CONS(o)->obj.cons.car = (kar))
#define SCM_SAL_CONS_SET_CDR(o, kdr) (SCM_AS_CONS(o)->obj.cons.cdr = (kdr))
+#define SCM_SAL_CONS_MUTABLEP(o) (SCM_MUTABLEP(o))
+#define SCM_SAL_CONS_SET_MUTABLE(o) (SCM_SET_MUTABLE(o))
+#define SCM_SAL_CONS_SET_IMMUTABLE(o) (SCM_SET_IMMUTABLE(o))
#define SCM_SAL_SYMBOLP(o) (SCM_TYPE(o) == ScmSymbol)
#define SCM_SAL_ENTYPE_SYMBOL(o) (SCM_ENTYPE((o), ScmSymbol))
Modified: branches/r5rs/sigscheme/src/storage.c
===================================================================
--- branches/r5rs/sigscheme/src/storage.c 2006-01-27 08:34:29 UTC (rev 3001)
+++ branches/r5rs/sigscheme/src/storage.c 2006-01-27 09:50:26 UTC (rev 3002)
@@ -163,6 +163,7 @@
obj = scm_alloc_cell();
SCM_ENTYPE_CONS(obj);
+ SCM_CONS_SET_MUTABLE(obj);
SET_CAR(obj, kar);
SET_CDR(obj, kdr);
@@ -170,6 +171,20 @@
}
ScmObj
+scm_make_immutable_cons(ScmObj kar, ScmObj kdr)
+{
+ ScmObj obj;
+
+ obj = scm_alloc_cell();
+ SCM_ENTYPE_CONS(obj);
+ SCM_CONS_SET_IMMUTABLE(obj);
+ SET_CAR(obj, kar);
+ SET_CDR(obj, kdr);
+
+ return obj;
+}
+
+ScmObj
scm_make_int(scm_int_t val)
{
ScmObj obj;
More information about the uim-commit
mailing list