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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-11-11 16:45:06 -0800 (Fri, 11 Nov 2005)
New Revision: 2120

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* sigscheme/sigschemeinternal.h
  - (ScmExp_cond_internal): New function decl
* sigscheme/eval.c
  - (ScmExp_cond_internal): New function. The code is moved from
    former ScmExp_cond() and modified
  - (ScmExp_cond): Move the code to ScmExp_cond_internal() and reform
    as wrapper to the function


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-11-12 00:27:07 UTC (rev 2119)
+++ branches/r5rs/sigscheme/eval.c	2005-11-12 00:45:06 UTC (rev 2120)
@@ -929,7 +929,8 @@
 /*===========================================================================
   R5RS : 4.2 Derived expression types : 4.2.1 Conditionals
 ===========================================================================*/
-ScmObj ScmExp_cond(ScmObj args, ScmEvalState *eval_state)
+/* body of 'cond' and also invoked from 'guard' of SRFI-34 */
+ScmObj ScmExp_cond_internal(ScmObj args, ScmEvalState *eval_state)
 {
     /*
      * (cond <clause1> <clause2> ...)
@@ -948,7 +949,7 @@
     ScmObj test   = SCM_FALSE;
     ScmObj exps   = SCM_FALSE;
     ScmObj proc   = SCM_FALSE;
-    DECLARE_FUNCTION("cond", SyntaxVariadicTailRec0);
+    DECLARE_INTERNAL_FUNCTION("cond" /* , SyntaxVariadicTailRec0 */);
 
     if (NO_MORE_ARG(args))
         ERR("cond: syntax error: at least one clause required");
@@ -1003,9 +1004,22 @@
         }
     }
 
-    return SCM_UNDEF;
+    /*
+     * To distinguish unmatched status from SCM_UNDEF from a clause, pure
+     * internal value SCM_INVALID is returned. Don't pass it to Scheme world.
+     */
+    return SCM_INVALID;
 }
 
+ScmObj ScmExp_cond(ScmObj args, ScmEvalState *eval_state)
+{
+    ScmObj ret;
+    DECLARE_FUNCTION("cond", SyntaxVariadicTailRec0);
+
+    ret = ScmExp_cond_internal(args, eval_state);
+    return (VALIDP(ret)) ? ret : SCM_UNDEF;
+}
+
 /* FIXME: argument extraction */
 ScmObj ScmExp_case(ScmObj key, ScmObj args, ScmEvalState *eval_state)
 {

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2005-11-12 00:27:07 UTC (rev 2119)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2005-11-12 00:45:06 UTC (rev 2120)
@@ -362,6 +362,8 @@
 ScmObj Scm_eval(ScmObj obj, ScmObj env);
 ScmObj Scm_tailcall(ScmObj proc, ScmObj args, ScmEvalState *eval_state);
 
+ScmObj ScmExp_cond_internal(ScmObj args, ScmEvalState *eval_state);
+
 /* error.c */
 void Scm_ThrowException(ScmObj errorobj) SCM_NORETURN;
 void SigScm_ShowErrorHeader(void);