[uim-commit] r1215 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Thu Aug 18 03:14:29 PDT 2005
Author: kzk
Date: 2005-08-18 03:13:46 -0700 (Thu, 18 Aug 2005)
New Revision: 1215
Modified:
branches/r5rs/sigscheme/error.c
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
Log:
* add "symbol-bound?", "symbol-value", "set-symbol-value!" for SIOD
compatibility.
* sigscheme/sigscheme.c
- (SigScm_Initialize): rename provided_feature to SigScm_features.
export "symbol-bound?", "symbol-value" and "set-symbol-value!".
* sigscheme/io.c
- (SigScm_features): renamed from provided_feature
- (ScmOp_load, ScmOp_require, ScmOp_provide): rename
provided_feature to SigScm_features.
* sigscheme/sigscheme.h
- (SigScm_features): renamed from provided_feature
- (ScmOp_symbol_boundp, ScmOp_symbol_value, ScmOp_set_symbol_value)
: new func for SIOD compatibility
- (ScmOp_boundp): removed
* sigscheme/operations.c
- (ScmOp_boundp): removed
* sigscheme/eval.c
- (qquote_internal, qquote_vector): initialize variables
- (ScmOp_symbol_boundp, ScmOp_symbol_value, ScmOp_set_symbol_value)
: new func for SIOD compatibility
* sigscheme/error.c
- (SigScm_ErrorObj): write obj to the error port
Modified: branches/r5rs/sigscheme/error.c
===================================================================
--- branches/r5rs/sigscheme/error.c 2005-08-18 07:43:45 UTC (rev 1214)
+++ branches/r5rs/sigscheme/error.c 2005-08-18 10:13:46 UTC (rev 1215)
@@ -85,7 +85,8 @@
fprintf(SCM_PORTINFO_FILE(current_error_port), "%s", msg);
/* print obj */
- SigScm_Display(obj);
+ SigScm_DisplayToPort(current_error_port, obj);
+ SigScm_DisplayToPort(current_error_port, Scm_NewStringCopying("\n"));
exit(-1);
}
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-08-18 07:43:45 UTC (rev 1214)
+++ branches/r5rs/sigscheme/eval.c 2005-08-18 10:13:46 UTC (rev 1215)
@@ -670,15 +670,14 @@
*/
static ScmObj qquote_internal(ScmObj qexpr, ScmObj env, int nest)
{
- ScmObj ls;
- ScmObj obj;
- ScmObj car;
- ScmObj args;
- ScmObj leftover;
- ScmObj result;
- ScmObj ret_list;
+ ScmObj ls = SCM_NIL;
+ ScmObj obj = SCM_NIL;
+ ScmObj car = SCM_NIL;
+ ScmObj args = SCM_NIL;
+ ScmObj result = SCM_NIL;
+ ScmObj ret_list = SCM_NIL;
ScmObj *ret_tail = NULL;
- int splice_flag;
+ int splice_flag = 0;
/* local "functions" */
#define qquote_copy_delayed() (QQUOTE_IS_VERBATIM(ret_list))
@@ -797,16 +796,17 @@
*/
static ScmObj qquote_vector(ScmObj src, ScmObj env, int nest)
{
- ScmObj splices = SCM_NIL;
- ScmObj expr;
- ScmObj ret;
- ScmObj *copy_buf;
- ScmObj result;
- ScmObj splice_len;
+ ScmObj splices = SCM_NIL;
+ ScmObj expr = SCM_NIL;
+ ScmObj ret = SCM_NIL;
+ ScmObj *copy_buf = NULL;
+ ScmObj result = SCM_NIL;
+ ScmObj splice_len = SCM_NIL;
int len = SCM_VECTOR_LEN(src);
int growth = 0;
int next_splice_index = -1;
- int i, j;
+ int i = 0;
+ int j = 0;
/* local "functions" */
#define qquote_copy_delayed() (copy_buf == NULL)
@@ -981,7 +981,7 @@
* not found in the environment
* if symbol is not bounded, error occurs
*/
- if (EQ(ScmOp_boundp(sym), SCM_FALSE))
+ if (EQ(ScmOp_symbol_boundp(sym), SCM_FALSE))
SigScm_ErrorObj("set! : unbound variable ", sym);
SCM_SETSYMBOL_VCELL(sym, ret);
@@ -1624,3 +1624,38 @@
{
return SCM_NIL;
}
+
+/*=======================================
+ SIOD compatible procedures
+
+ TODO : remove these functions!
+=======================================*/
+ScmObj ScmOp_symbol_boundp(ScmObj obj)
+{
+ if (SCM_SYMBOLP(obj)
+ && !SCM_EQ(SCM_SYMBOL_VCELL(obj), SCM_UNBOUND))
+ {
+ return SCM_TRUE;
+ }
+
+ return SCM_FALSE;
+}
+
+ScmObj ScmOp_symbol_value(ScmObj arg, ScmObj env)
+{
+ ScmObj var = SCM_CAR(arg);
+
+ if (!SCM_SYMBOLP(var))
+ SigScm_ErrorObj("symbol-value : require symbol but got ", var);
+
+ return symbol_value(var, env);
+}
+
+ScmObj ScmOp_set_symbol_value(ScmObj arg, ScmObj env)
+{
+ int flag = 0;
+
+ return ScmExp_set(arg,
+ &env,
+ &flag);
+}
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2005-08-18 07:43:45 UTC (rev 1214)
+++ branches/r5rs/sigscheme/io.c 2005-08-18 10:13:46 UTC (rev 1215)
@@ -55,7 +55,7 @@
ScmObj current_input_port = NULL;
ScmObj current_output_port = NULL;
-ScmObj provided_feature = NULL;
+ScmObj SigScm_features = NULL;
static const char *lib_path = NULL;
@@ -499,12 +499,12 @@
/* construct loaded_str */
loaded_str = create_loaded_str(filename);
- if (EQ(ScmOp_member(loaded_str, SCM_SYMBOL_VCELL(provided_feature)), SCM_FALSE)) {
+ if (EQ(ScmOp_member(loaded_str, SCM_SYMBOL_VCELL(SigScm_features)), SCM_FALSE)) {
/* not provided, so load it! */
ScmOp_load(filename);
- /* record to provided_feature */
- SCM_SYMBOL_VCELL(provided_feature) = Scm_NewCons(loaded_str, SCM_SYMBOL_VCELL(provided_feature));
+ /* record to SigScm_features */
+ SCM_SYMBOL_VCELL(SigScm_features) = Scm_NewCons(loaded_str, SCM_SYMBOL_VCELL(SigScm_features));
}
return SCM_TRUE;
@@ -528,8 +528,8 @@
if (!SCM_STRINGP(feature))
SigScm_ErrorObj("provide : string required but got ", feature);
- /* record to provided_feature */
- SCM_SYMBOL_VCELL(provided_feature) = Scm_NewCons(feature, SCM_SYMBOL_VCELL(provided_feature));
+ /* record to SigScm_features */
+ SCM_SYMBOL_VCELL(SigScm_features) = Scm_NewCons(feature, SCM_SYMBOL_VCELL(SigScm_features));
return SCM_TRUE;
}
@@ -539,7 +539,7 @@
if (!SCM_STRINGP(feature))
SigScm_ErrorObj("provide : string required but got ", feature);
- if (EQ(ScmOp_member(feature, provided_feature), SCM_TRUE))
+ if (EQ(ScmOp_member(feature, SigScm_features), SCM_TRUE))
return SCM_TRUE;
return SCM_FALSE;
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-08-18 07:43:45 UTC (rev 1214)
+++ branches/r5rs/sigscheme/operations.c 2005-08-18 10:13:46 UTC (rev 1215)
@@ -1178,17 +1178,6 @@
return SCM_FALSE;
}
-ScmObj ScmOp_boundp(ScmObj obj)
-{
- if (SCM_SYMBOLP(obj)
- && !SCM_EQ(SCM_SYMBOL_VCELL(obj), SCM_UNBOUND))
- {
- return SCM_TRUE;
- }
-
- return SCM_FALSE;
-}
-
ScmObj ScmOp_symbol_to_string(ScmObj obj)
{
if (!SCM_SYMBOLP(obj))
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-08-18 07:43:45 UTC (rev 1214)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-08-18 10:13:46 UTC (rev 1215)
@@ -100,6 +100,7 @@
SigScm_quasiquote = Scm_Intern("quasiquote");
SigScm_unquote = Scm_Intern("unquote");
SigScm_unquote_splicing = Scm_Intern("unquote-splicing");
+ SigScm_features = Scm_Intern("*features*");
/*=======================================================================
Export Scheme Special Symbols
=======================================================================*/
@@ -133,6 +134,9 @@
Scm_RegisterFuncR("define" , ScmExp_define);
Scm_RegisterFunc1("scheme-report-environment", ScmOp_scheme_report_environment);
Scm_RegisterFunc1("null-environment" , ScmOp_null_environment);
+ Scm_RegisterFunc1("symbol-bound?" , ScmOp_symbol_boundp);
+ Scm_RegisterFuncL("symbol-value" , ScmOp_symbol_value);
+ Scm_RegisterFuncL("set-symbol-value!" , ScmOp_set_symbol_value);
/* operations.c */
Scm_RegisterFunc2("eqv?" , ScmOp_eqvp);
Scm_RegisterFunc2("eq?" , ScmOp_eqp);
@@ -285,11 +289,7 @@
SigScm_gc_protect(current_output_port);
current_error_port = Scm_NewFilePort(stderr, "stderr", PORT_OUTPUT);
SigScm_gc_protect(current_error_port);
- /*=======================================================================
- Other Variables To Protect From GC
- =======================================================================*/
- provided_feature = Scm_Intern("*features*");
- SigScm_gc_protect(provided_feature);
+
#if USE_SRFI1
/*=======================================================================
SRFI-1 Procedures
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-08-18 07:43:45 UTC (rev 1214)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-08-18 10:13:46 UTC (rev 1215)
@@ -66,7 +66,7 @@
extern ScmObj current_output_port;
extern ScmObj current_error_port;
-extern ScmObj provided_feature;
+extern ScmObj SigScm_features;
/*=======================================
Macro Declarations
@@ -164,6 +164,9 @@
ScmObj ScmExp_define(ScmObj arg, ScmObj *envp, int *tail_flag);
ScmObj ScmOp_scheme_report_environment(ScmObj version);
ScmObj ScmOp_null_environment(ScmObj version);
+ScmObj ScmOp_symbol_boundp(ScmObj obj);
+ScmObj ScmOp_symbol_value(ScmObj var, ScmObj env);
+ScmObj ScmOp_set_symbol_value(ScmObj var, ScmObj env);
/* operations.c */
ScmObj ScmOp_eqvp(ScmObj obj1, ScmObj obj2);
@@ -243,7 +246,6 @@
ScmObj ScmOp_assv(ScmObj obj, ScmObj alist);
ScmObj ScmOp_assoc(ScmObj obj, ScmObj alist);
ScmObj ScmOp_symbolp(ScmObj obj);
-ScmObj ScmOp_boundp(ScmObj obj);
ScmObj ScmOp_symbol_to_string(ScmObj obj);
ScmObj ScmOp_string_to_symbol(ScmObj str);
More information about the uim-commit
mailing list