[uim-commit] r2236 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Tue Nov 22 17:37:57 PST 2005
Author: kzk
Date: 2005-11-22 17:37:54 -0800 (Tue, 22 Nov 2005)
New Revision: 2236
Modified:
branches/r5rs/sigscheme/error.c
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/main.c
branches/r5rs/sigscheme/operations-nonstd.c
branches/r5rs/sigscheme/operations-srfi34.c
branches/r5rs/sigscheme/operations-srfi6.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/read.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemeinternal.h
branches/r5rs/sigscheme/sigschemetype.h
branches/r5rs/sigscheme/storage.c
Log:
* Introduce mutable & immutable string
* sigscheme/read.c
- (read_string): use Scm_NewImmutableStringCopying
* sigscheme/error.c
- (SigScm_InitError, SigScm_Die, SigScm_Error, SigScm_ErrorObj,
Scm_ErrorObj): use Scm_NewImmutableStringCopying
* sigscheme/operations-srfi34.c
- (MAKE_STR_COPYING): use Scm_NewImmutableStringCopying
* sigscheme/storage.c
- (Scm_NewString): change args
- (Scm_NewImmutableString, Scm_NewImmutableStringCopying,
Scm_NewMutableString, Scm_NewMutableStringCopying): new func
* sigscheme/operations-srfi6.c
- (ScmOp_SRFI6_get_output_string): use Scm_NewMutableStringCopying
* sigscheme/io.c
- (SigScm_load_internal): use Scm_NewImmutableString
* sigscheme/sigschemeinternal.h
- (ASSERT_MUTABLEP): new macro
* sigscheme/operations.c
- (ScmOp_number2string): use Scm_NewMutableStringCopying
- (ScmOp_make_string): use Scm_NewMutableString*
- (ScmOp_string_setd): add ASSERT_MUTABLEP
- (ScmOp_substring): add ASSERT_MUTABLEP, use Scm_NewMutableString
- (ScmOp_string_append): use Scm_NewMutableString*
- (ScmOp_list2string): use Scm_NewMutableString*
- (ScmOp_string_copy): use Scm_NewMutableStringCopying
- (ScmOp_string_filld): add ASSERT_MUTABLEP
* sigscheme/operations-nonstd.c
- (ScmOp_load_path, create_loaded_str)
: use Scm_NewMutableStringCopying
* sigscheme/sigscheme.c
- (SigScm_Initialize_internal): use Scm_NewImmutableStringCopying
* sigscheme/sigscheme.h
- (Scm_NewString): change args
- (Scm_NewImmutableString, Scm_NewImmutableStringCopying,
Scm_NewMutableString, Scm_NewMutableStringCopying): new func
* sigscheme/sigschemetype.h
- (SCM_STRING_SET_MUTABLE, SCM_STRING_SET_IMMUTABLE): add casting
* sigscheme/main.c
- (main): use Scm_NewImmutableStringCopying
Modified: branches/r5rs/sigscheme/error.c
===================================================================
--- branches/r5rs/sigscheme/error.c 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/error.c 2005-11-23 01:37:54 UTC (rev 2236)
@@ -80,7 +80,7 @@
/* allocate a cons cell as unique ID */
err_obj_tag = CONS(SCM_UNDEF, SCM_UNDEF);
- str_srfi34 = Scm_NewStringCopying("srfi-34");
+ str_srfi34 = Scm_NewImmutableStringCopying("srfi-34");
srfi34_is_provided = FALSE;
fatal_err_looped = FALSE;
@@ -210,7 +210,7 @@
/* FIXME: provide replace asprintf */
reason = strdup("SigScheme Died");
#endif /* HAVE_ASPRINTF */
- err_obj = Scm_MakeErrorObj(Scm_NewString(reason), LIST_1(SCM_UNDEF));
+ err_obj = Scm_MakeErrorObj(Scm_NewImmutableString(reason), LIST_1(SCM_UNDEF));
ScmOp_sscm_fatal_error(err_obj);
/* NOTREACHED */
return 1; /* dummy value for boolean expression */
@@ -230,7 +230,7 @@
/* FIXME: provide replace vasprintf */
reason = strdup(msg);
#endif /* HAVE_VASPRINTF */
- err_obj = Scm_MakeErrorObj(Scm_NewString(reason), LIST_1(SCM_UNDEF));
+ err_obj = Scm_MakeErrorObj(Scm_NewImmutableString(reason), LIST_1(SCM_UNDEF));
Scm_RaiseError(err_obj);
/* NOTREACHED */
}
@@ -240,7 +240,7 @@
{
ScmObj err_obj;
- err_obj = Scm_MakeErrorObj(Scm_NewStringCopying(msg), LIST_1(obj));
+ err_obj = Scm_MakeErrorObj(Scm_NewImmutableStringCopying(msg), LIST_1(obj));
Scm_RaiseError(err_obj);
/* NOTREACHED */
}
@@ -257,7 +257,7 @@
/* FIXME: provide replace asprintf */
reason = strdup(msg);
#endif /* HAVE_ASPRINTF */
- err_obj = Scm_MakeErrorObj(Scm_NewString(reason), LIST_1(obj));
+ err_obj = Scm_MakeErrorObj(Scm_NewImmutableString(reason), LIST_1(obj));
Scm_RaiseError(err_obj);
/* NOTREACHED */
}
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/io.c 2005-11-23 01:37:54 UTC (rev 2236)
@@ -487,7 +487,7 @@
SigScm_Error("SigScm_load_internal : file \"%s\" not found",
c_filename);
- filepath = Scm_NewString(c_filepath);
+ filepath = Scm_NewImmutableString(c_filepath);
port = ScmOp_open_input_file(filepath);
/* read & eval cycle */
Modified: branches/r5rs/sigscheme/main.c
===================================================================
--- branches/r5rs/sigscheme/main.c 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/main.c 2005-11-23 01:37:54 UTC (rev 2236)
@@ -155,7 +155,7 @@
#endif
SigScm_GC_Protect(&feature_id_siod);
- feature_id_siod = Scm_NewStringCopying(FEATURE_ID_SIOD);
+ feature_id_siod = Scm_NewImmutableStringCopying(FEATURE_ID_SIOD);
if (argc < 2) {
#if SCM_GCC4_READY_GC
Modified: branches/r5rs/sigscheme/operations-nonstd.c
===================================================================
--- branches/r5rs/sigscheme/operations-nonstd.c 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/operations-nonstd.c 2005-11-23 01:37:54 UTC (rev 2236)
@@ -92,7 +92,7 @@
ScmObj ScmOp_load_path(void)
{
DECLARE_FUNCTION("load-path", ProcedureFixed0);
- return Scm_NewStringCopying(scm_lib_path);
+ return Scm_NewImmutableStringCopying(scm_lib_path);
}
/* FIXME: add ScmObj SigScm_require(const char *c_filename) */
@@ -132,7 +132,7 @@
loaded_str = (char*)malloc(sizeof(char) * size);
snprintf(loaded_str, size, "*%s-loaded*", SCM_STRING_STR(filename));
- return Scm_NewString(loaded_str);
+ return Scm_NewImmutableString(loaded_str);
}
/*
Modified: branches/r5rs/sigscheme/operations-srfi34.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi34.c 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/operations-srfi34.c 2005-11-23 01:37:54 UTC (rev 2236)
@@ -61,7 +61,7 @@
#define ERRMSG_HANDLER_RETURNED "handler returned"
#define ERRMSG_FALLBACK_EXHAUSTED "fallback handler exhausted"
-#define MAKE_STR_COPYING Scm_NewStringCopying
+#define MAKE_STR_COPYING Scm_NewImmutableStringCopying
#define DECLARE_PRIVATE_FUNCTION(func_name, type) \
DECLARE_INTERNAL_FUNCTION(func_name)
Modified: branches/r5rs/sigscheme/operations-srfi6.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi6.c 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/operations-srfi6.c 2005-11-23 01:37:54 UTC (rev 2236)
@@ -114,7 +114,7 @@
SCM_ASSERT_LIVE_PORT(port);
cport = SCM_CHARPORT_DYNAMIC_CAST(ScmBaseCharPort, SCM_PORT_IMPL(port));
- return Scm_NewStringCopying(ScmOutputStrPort_str(cport->bport));
+ return Scm_NewMutableStringCopying(ScmOutputStrPort_str(cport->bport));
}
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/operations.c 2005-11-23 01:37:54 UTC (rev 2236)
@@ -534,7 +534,7 @@
if (r == 10 && SCM_INT_VALUE (num) < 0)
*--p = '-';
- return Scm_NewStringCopying(p);
+ return Scm_NewMutableStringCopying(p);
}
ScmObj ScmOp_string2number(ScmObj str, ScmObj args)
@@ -964,7 +964,7 @@
{
DECLARE_FUNCTION("symbol->string", ProcedureFixed1);
ASSERT_SYMBOLP(obj);
- return Scm_NewStringCopying(SCM_SYMBOL_NAME(obj));
+ return Scm_NewImmutableStringCopying(SCM_SYMBOL_NAME(obj));
}
ScmObj ScmOp_string2symbol(ScmObj str)
@@ -1158,7 +1158,7 @@
ASSERT_INTP(length);
len = SCM_INT_VALUE(length);
if (len == 0)
- return Scm_NewStringCopying("");
+ return Scm_NewMutableStringCopying("");
if (len < 0)
ERR_OBJ("length out of range", length);
@@ -1181,7 +1181,7 @@
}
new_str[fillstr_size * len] = '\0';
- return Scm_NewString(new_str);
+ return Scm_NewMutableString(new_str);
}
ScmObj ScmOp_string(ScmObj args)
@@ -1237,6 +1237,7 @@
DECLARE_FUNCTION("string-set!", ProcedureFixed3);
ASSERT_STRINGP(str);
+ ASSERT_MUTABLEP(str);
ASSERT_INTP(k);
ASSERT_CHARP(ch);
@@ -1296,6 +1297,7 @@
DECLARE_FUNCTION("substring", ProcedureFixed3);
ASSERT_STRINGP(str);
+ ASSERT_MUTABLEP(str);
ASSERT_INTP(start);
ASSERT_INTP(end);
@@ -1321,7 +1323,7 @@
memcpy(new_str, SCM_MBS_GET_STR(mbs), SCM_MBS_GET_SIZE(mbs));
new_str[SCM_MBS_GET_SIZE(mbs)] = 0;
- return Scm_NewString(new_str);
+ return Scm_NewMutableString(new_str);
}
ScmObj ScmOp_string_append(ScmObj args)
@@ -1336,7 +1338,7 @@
DECLARE_FUNCTION("string-append", ProcedureVariadic0);
if (NO_MORE_ARG(args))
- return Scm_NewStringCopying("");
+ return Scm_NewMutableStringCopying("");
/* count total size of the new string */
for (strings = args; !NULLP(strings); strings = CDR(strings)) {
@@ -1359,7 +1361,7 @@
p += strlen(SCM_STRING_STR(obj));
}
- return Scm_NewString(new_str);
+ return Scm_NewMutableString(new_str);
}
ScmObj ScmOp_string2list(ScmObj string)
@@ -1413,7 +1415,7 @@
ERR_OBJ("list required but got", lst);
if (NULLP(lst))
- return Scm_NewStringCopying("");
+ return Scm_NewMutableStringCopying("");
/* count total size of the string */
for (chars = lst; !NULLP(chars); chars = CDR(chars)) {
@@ -1437,14 +1439,14 @@
p += len;
}
- return Scm_NewString(new_str);
+ return Scm_NewMutableString(new_str);
}
ScmObj ScmOp_string_copy(ScmObj string)
{
DECLARE_FUNCTION("string-copy", ProcedureFixed1);
ASSERT_STRINGP(string);
- return Scm_NewStringCopying(SCM_STRING_STR(string));
+ return Scm_NewMutableStringCopying(SCM_STRING_STR(string));
}
ScmObj ScmOp_string_filld(ScmObj string, ScmObj ch)
@@ -1457,6 +1459,7 @@
DECLARE_FUNCTION("string-fill!", ProcedureFixed2);
ASSERT_STRINGP(string);
+ ASSERT_MUTABLEP(string);
ASSERT_CHARP(ch);
/* create new str */
Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/read.c 2005-11-23 01:37:54 UTC (rev 2236)
@@ -383,7 +383,7 @@
case '\"':
stringbuf[stringlen] = '\0';
- return Scm_NewStringCopying(stringbuf);
+ return Scm_NewImmutableStringCopying(stringbuf);
case '\\':
/*
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-11-23 01:37:54 UTC (rev 2236)
@@ -195,7 +195,7 @@
Fixing up
=======================================================================*/
/* to evaluate SigScheme-dependent codes conditionally */
- ScmOp_provide(Scm_NewStringCopying("sigscheme"));
+ ScmOp_provide(Scm_NewImmutableStringCopying("sigscheme"));
}
void SigScm_Finalize()
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-11-23 01:37:54 UTC (rev 2236)
@@ -380,8 +380,11 @@
ScmObj Scm_NewInt(int val);
ScmObj Scm_NewSymbol(char *name, ScmObj v_cell);
ScmObj Scm_NewChar(char *ch);
-ScmObj Scm_NewString(char *str);
-ScmObj Scm_NewStringCopying(const char *str);
+ScmObj Scm_NewString(char *str, int is_immutable);
+ScmObj Scm_NewImmutableString(char *str);
+ScmObj Scm_NewImmutableStringCopying(const char *str);
+ScmObj Scm_NewMutableString(char *str);
+ScmObj Scm_NewMutableStringCopying(const char *str);
ScmObj Scm_NewFunc(enum ScmFuncTypeCode type, ScmFuncType func);
ScmObj Scm_NewClosure(ScmObj exp, ScmObj env);
ScmObj Scm_NewVector(ScmObj *vec, int len);
Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2005-11-23 01:37:54 UTC (rev 2236)
@@ -307,6 +307,15 @@
#define NAMEHASH_SIZE 1024
/*=======================================
+ String Mutation Assertion
+=======================================*/
+#define ASSERT_MUTABLEP(str) \
+ do { \
+ if (SCM_STRING_MUTATION_TYPE(str) == SCM_STR_IMMUTABLE) \
+ ERR_OBJ("attempted to modify immutable string", str); \
+ } while (/* CONSTCOND */ 0)
+
+/*=======================================
List Constructor
=======================================*/
typedef ScmRef ScmQueue;
@@ -323,6 +332,7 @@
} while (0)
#define SCM_QUEUE_TERMINATOR(_q) (DEREF(_q))
#define SCM_QUEUE_SLOPPY_APPEND(_q, _lst) (DEREF(_q) = (_lst))
+
/*=======================================
Function Declarations
=======================================*/
Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/sigschemetype.h 2005-11-23 01:37:54 UTC (rev 2236)
@@ -309,10 +309,10 @@
#define SCM_STRING_SET_LEN(a, len) (SCM_STRING_LEN(a) = (len))
#define SCM_STRING_MUTATION_TYPE(a) ((enum ScmStrMutationType)(((unsigned int)SCM_AS_STRING(a)->obj.string.str) \
& SCM_STRING_MUTATION_TYPE_MASK))
-#define SCM_STRING_SET_MUTABLE(a) (SCM_AS_STRING(a)->obj.string.str = ((unsigned int)(SCM_AS_STRING(a)->obj.string.str)) \
- | SCM_STR_MUTABLE)
-#define SCM_STRING_SET_IMMMUTABLE(a) (SCM_AS_STRING(a)->obj.string.str = ((unsigned int)(SCM_AS_STRING(a)->obj.string.str)) \
- | SCM_STR_IMMUTABLE)
+#define SCM_STRING_SET_MUTABLE(a) (SCM_AS_STRING(a)->obj.string.str = (char*)(((unsigned int)(SCM_AS_STRING(a)->obj.string.str)) \
+ | SCM_STR_MUTABLE))
+#define SCM_STRING_SET_IMMUTABLE(a) (SCM_AS_STRING(a)->obj.string.str = (char*)(((unsigned int)(SCM_AS_STRING(a)->obj.string.str)) \
+ | SCM_STR_IMMUTABLE))
#define SCM_FUNCP(a) (SCM_TYPE(a) == ScmFunc)
#define SCM_ENTYPE_FUNC(a) (SCM_ENTYPE((a), ScmFunc))
Modified: branches/r5rs/sigscheme/storage.c
===================================================================
--- branches/r5rs/sigscheme/storage.c 2005-11-23 01:21:27 UTC (rev 2235)
+++ branches/r5rs/sigscheme/storage.c 2005-11-23 01:37:54 UTC (rev 2236)
@@ -202,7 +202,7 @@
return obj;
}
-ScmObj Scm_NewString(char *str)
+ScmObj Scm_NewString(char *str, int is_immutable)
{
ScmObj obj = SigScm_NewObjFromHeap();
@@ -210,20 +210,32 @@
SCM_STRING_SET_STR(obj, str);
SCM_STRING_SET_LEN(obj, str ? Scm_mb_bare_c_strlen(str) : 0);
+ if (is_immutable)
+ SCM_STRING_SET_IMMUTABLE(obj);
+ else
+ SCM_STRING_SET_MUTABLE(obj);
+
return obj;
}
-ScmObj Scm_NewStringCopying(const char *str)
+ScmObj Scm_NewImmutableString(char *str)
{
- ScmObj obj = SigScm_NewObjFromHeap();
+ return Scm_NewString(str, 1);
+}
- if (!str) str = "";
+ScmObj Scm_NewImmutableStringCopying(const char *str)
+{
+ return Scm_NewString(strdup(str), 1);
+}
- SCM_ENTYPE_STRING(obj);
- SCM_STRING_SET_STR(obj, strdup(str));
- SCM_STRING_SET_LEN(obj, Scm_mb_bare_c_strlen(str));
+ScmObj Scm_NewMutableString(char *str)
+{
+ return Scm_NewString(str, 0);
+}
- return obj;
+ScmObj Scm_NewMutableStringCopying(const char *str)
+{
+ return Scm_NewString(strdup(str), 0);
}
ScmObj Scm_NewFunc(enum ScmFuncTypeCode type, ScmFuncType func)
More information about the uim-commit
mailing list