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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-10-02 08:10:34 -0700 (Sun, 02 Oct 2005)
New Revision: 1739

Modified:
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigschemeinternal.h
   branches/r5rs/sigscheme/sigschemetype.h
Log:
* sigscheme/sigschemetype.h
  - (SCM_PROCEDUREP): New macro
* sigscheme/sigschemeinternal.h
  - (PROCEDUREP, ASSERT_PROCEDUREP): New macro
* sigscheme/operations.c
  - (ScmOp_procedurep): Simplify with PROCEDUREP
  - (ScmOp_call_with_current_continuation): Simplify with
    ASSERT_PROCEDUREP


Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2005-10-02 14:50:50 UTC (rev 1738)
+++ branches/r5rs/sigscheme/operations.c	2005-10-02 15:10:34 UTC (rev 1739)
@@ -1672,8 +1672,7 @@
 ScmObj ScmOp_procedurep(ScmObj obj)
 {
     DECLARE_FUNCTION("procedure?", ProcedureFixed1);
-    return ((FUNCP(obj) && !SYNTAXP(obj))
-            || CLOSUREP(obj) || CONTINUATIONP(obj)) ? SCM_TRUE : SCM_FALSE;
+    return (PROCEDUREP(obj)) ? SCM_TRUE : SCM_FALSE;
 }
 
 ScmObj ScmOp_map(ScmObj proc, ScmObj args)
@@ -1791,8 +1790,7 @@
     ScmObj ret  = SCM_FALSE;
     DECLARE_FUNCTION("call-with-current-continuation", ProcedureFixed1);
 
-    if (FALSEP(ScmOp_procedurep(proc)))
-        SigScm_ErrorObj("call-with-current-continuation : procedure required but got ", proc);
+    ASSERT_PROCEDUREP(proc);
 
     cont = Scm_NewContinuation();
 

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2005-10-02 14:50:50 UTC (rev 1738)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2005-10-02 15:10:34 UTC (rev 1739)
@@ -138,6 +138,7 @@
 #define FUNCP          SCM_FUNCP
 #define SYNTAXP        SCM_SYNTAXP
 #define CLOSUREP       SCM_CLOSUREP
+#define PROCEDUREP     SCM_PROCEDUREP
 #define VECTORP        SCM_VECTORP
 #define PORTP          SCM_PORTP
 #define CONTINUATIONP  SCM_CONTINUATIONP
@@ -333,6 +334,7 @@
 #define ASSERT_VECTORP(obj)  ASSERT_TYPE(VECTORP, "vector", (obj))
 #define ASSERT_PORTP(obj)    ASSERT_TYPE(PORTP, "port", (obj))
 #define ASSERT_CONTINUATIONP(obj) ASSERT_TYPE(CONTINUATIONP, "continuation", (obj))
+#define ASSERT_PROCEDUREP(obj) ASSERT_TYPE(PROCEDUREP, "procedure", (obj))
 
 
 /*=======================================

Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h	2005-10-02 14:50:50 UTC (rev 1738)
+++ branches/r5rs/sigscheme/sigschemetype.h	2005-10-02 15:10:34 UTC (rev 1739)
@@ -345,6 +345,10 @@
 #define SCM_FUNC_SET_CFUNC(a, func)     (SCM_FUNC_CFUNC(a) = (ScmFuncType)(func))
 #define SCM_SYNTAXP(a) (SCM_FUNCP(a)                                         \
                         && (SCM_FUNC_TYPECODE(a) & SCM_FUNCTYPE_SYNTAX))
+#define SCM_PROCEDUREP(a) ((SCM_FUNCP(a)                                     \
+                            && !(SCM_FUNC_TYPECODE(a) & SCM_FUNCTYPE_SYNTAX)) \
+                           || SCM_CLOSUREP(a)                                \
+                           || SCM_CONTINUATIONP(a))
 
 #define SCM_CLOSUREP(a) (SCM_TYPE(a) == ScmClosure)
 #define SCM_ENTYPE_CLOSURE(a) (SCM_ENTYPE((a), ScmClosure))