[uim-commit] r2092 - in branches/r5rs/sigscheme: . test

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-11-08 10:18:39 -0800 (Tue, 08 Nov 2005)
New Revision: 2092

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/sigscheme.c
   branches/r5rs/sigscheme/sigschemeinternal.h
   branches/r5rs/sigscheme/test/test-exp.scm
Log:
* sigscheme/sigschemeinternal.h
  - (Scm_sym_else, Scm_sym_yields): New variable decl
  - (SYM_ELSE, SYM_YIELDS): New macro
* sigscheme/sigscheme.c
  - (Scm_sym_else, Scm_sym_yields): New variable
  - (SigScm_Initialize_internal):
    * Add initialization of Scm_sym_else and Scm_sym_yields
    * Remove #t value binding to "=>"
* sigscheme/eval.c
  - (ScmExp_cond): Remove expensive Scm_Intern()
* sigscheme/test/test-exp.scm
  - Change status of the 3 FAILED tests to passed


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-11-08 18:05:46 UTC (rev 2091)
+++ branches/r5rs/sigscheme/eval.c	2005-11-08 18:18:39 UTC (rev 2092)
@@ -984,8 +984,7 @@
              * this procedure is then called on the value of the <test> and the value
              * returned by this procedure is returned by the cond expression.
              */
-            /* FIXME: remove expensive Scm_Intern() */
-            if (EQ(Scm_Intern("=>"), CAR(exps)) && !NULLP(CDR(exps))) {
+            if (EQ(SYM_YIELDS, CAR(exps)) && !NULLP(CDR(exps))) {
                 proc = EVAL(CADR(exps), env);
                 if (FALSEP(ScmOp_procedurep(proc)))
                     ERR_OBJ("the value of exp after => must be the procedure but got", proc);

Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c	2005-11-08 18:05:46 UTC (rev 2091)
+++ branches/r5rs/sigscheme/sigscheme.c	2005-11-08 18:18:39 UTC (rev 2092)
@@ -62,6 +62,7 @@
 =======================================*/
 ScmObj Scm_sym_quote, Scm_sym_quasiquote;
 ScmObj Scm_sym_unquote, Scm_sym_unquote_splicing;
+ScmObj Scm_sym_else, Scm_sym_yields;
 
 #if SCM_COMPAT_SIOD
 static ScmObj scm_return_value    = NULL;
@@ -142,14 +143,11 @@
     Scm_sym_quasiquote       = Scm_Intern("quasiquote");
     Scm_sym_unquote          = Scm_Intern("unquote");
     Scm_sym_unquote_splicing = Scm_Intern("unquote-splicing");
-#if 0
-    /* FIXME: Rewrite ScmExp_cond() and ScmExp_case(), and enable this */
-    SigScm_else             = Scm_Intern("else");
-    SigScm_foo              = Scm_Intern("=>");
-#else
+    Scm_sym_else             = Scm_Intern("else");
+    Scm_sym_yields           = Scm_Intern("=>");
+#if 1
     /* FIXME: obsolete this. don't set SCM_TRUE and rely on the value */
     SCM_SYMBOL_SET_VCELL(Scm_Intern("else"), SCM_TRUE);
-    SCM_SYMBOL_SET_VCELL(Scm_Intern("=>"),   SCM_TRUE);
 #endif
 
 #if SCM_USE_NONSTD_FEATURES

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2005-11-08 18:05:46 UTC (rev 2091)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2005-11-08 18:18:39 UTC (rev 2092)
@@ -68,6 +68,9 @@
 /*=======================================
    Variable Declarations
 =======================================*/
+/* sigscheme.c */
+extern ScmObj Scm_sym_else, Scm_sym_yields;
+
 /* eval.c */
 extern struct trace_frame *scm_trace_root;
 
@@ -120,6 +123,8 @@
 #define SYM_QUASIQUOTE       SCM_SYM_QUASIQUOTE
 #define SYM_UNQUOTE          SCM_SYM_UNQUOTE
 #define SYM_UNQUOTE_SPLICING SCM_SYM_UNQUOTE_SPLICING
+#define SYM_ELSE             Scm_sym_else
+#define SYM_YIELDS           Scm_sym_yields
 
 #define EQ             SCM_EQ
 #define NULLP          SCM_NULLP

Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm	2005-11-08 18:05:46 UTC (rev 2091)
+++ branches/r5rs/sigscheme/test/test-exp.scm	2005-11-08 18:18:39 UTC (rev 2092)
@@ -101,18 +101,15 @@
                    (lambda ()
                      (cond
                       (else)))))
-;; FAILED
 (assert-error  "cond invalid form #6"
                (lambda ()
                  (cond
                   (#t =>))))
-;; FAILED
 (assert-error  "cond invalid form #7"
                (lambda ()
                  (cond
                   (#t =>)
                   (else #t))))
-;; FAILED
 (assert-error  "cond invalid form #8"
                (lambda ()
                  (cond