[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