[uim-commit] r1440 - branches/r5rs/sigscheme

yamaken at freedesktop.org yamaken at freedesktop.org
Tue Sep 6 07:19:24 PDT 2005


Author: yamaken
Date: 2005-09-06 07:19:21 -0700 (Tue, 06 Sep 2005)
New Revision: 1440

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/operations-siod.c
   branches/r5rs/sigscheme/sigscheme.h
Log:
* sigscheme/sigscheme.h
  - (SCM_SYMBOL_BOUNDP): New macro
* sigscheme/operations-siod.c
  - (ScmOp_symbol_boundp): Simplify with SCM_SYMBOL_BOUNDP()
* sigscheme/eval.c
  - (ScmExp_set):
    * Replace SCM_COMPAT_SIOD dependent ScmOp_symbol_boundp with
      equivalent code. This recovered R5RS-mode compilation
    * Add type check for the symbol
    * Return SCM_UNDEF when SCM_STRICT_R5RS


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-09-06 14:11:55 UTC (rev 1439)
+++ branches/r5rs/sigscheme/eval.c	2005-09-06 14:19:21 UTC (rev 1440)
@@ -954,9 +954,11 @@
     ret = EVAL(val, env);
     tmp = lookup_environment(sym, env);
     if (NULLP(tmp)) {
+        if (!SYMBOLP(sym))
+            SigScm_ErrorObj("set! : symbol required but got ", sym);
         /* Not found in the environment
-           If symbol is not bounded, error occurs */
-        if (FALSEP(ScmOp_symbol_boundp(sym)))
+           If symbol is not bound, error occurs */
+        if (!SCM_SYMBOL_BOUNDP(sym))
             SigScm_ErrorObj("set! : unbound variable ", sym);
 
         SCM_SYMBOL_SET_VCELL(sym, ret);
@@ -965,7 +967,11 @@
         SET_CAR(tmp, ret);
     }
 
+#if SCM_STRICT_R5RS
+    return SCM_UNDEF;
+#else
     return ret;
+#endif
 }
 
 

Modified: branches/r5rs/sigscheme/operations-siod.c
===================================================================
--- branches/r5rs/sigscheme/operations-siod.c	2005-09-06 14:11:55 UTC (rev 1439)
+++ branches/r5rs/sigscheme/operations-siod.c	2005-09-06 14:19:21 UTC (rev 1440)
@@ -70,17 +70,11 @@
  * TODO:
  * - generalize to SCM_USE_NONSTD_FEATURES
  * - describe compatibility with de facto standard of other Scheme
- *   implementations
+ *   implementations (accept env as optional arg, etc)
  */
 ScmObj ScmOp_symbol_boundp(ScmObj obj)
 {
-    if (SYMBOLP(obj)
-        && !EQ(SCM_SYMBOL_VCELL(obj), SCM_UNBOUND))
-    {
-        return SCM_TRUE;
-    }
-
-    return SCM_FALSE;
+    return (SYMBOLP(obj) && SCM_SYMBOL_BOUNDP(obj)) ? SCM_TRUE : SCM_FALSE;
 }
 
 /*

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-09-06 14:11:55 UTC (rev 1439)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-09-06 14:19:21 UTC (rev 1440)
@@ -92,6 +92,8 @@
 #define SCM_ASSERT(cond) \
     (cond ? 0 : SigScm_Die("assertion failed.", __FILE__, __LINE__))
 
+#define SCM_SYMBOL_BOUNDP(sym) (SCM_NEQ(SCM_SYMBOL_VCELL(sym), SCM_UNBOUND))
+
 #define SCM_CONS(kar, kdr) (Scm_NewCons(kar, kdr))
 
 #define SCM_LIST_1(elm0) \



More information about the uim-commit mailing list