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

[kzk at freedesktop.org]

Author: kzk
Date: 2005-08-23 21:42:03 -0700 (Tue, 23 Aug 2005)
New Revision: 1295

Modified:
   branches/r5rs/sigscheme/datas.c
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigschemetype.h
Log:
* improve equal? procedure

* sigscheme/operations.c
  - (ScmOp_equalp): implement ScmFunc, ScmClosure, ScmPort and
    ScmContinuation type handling

* sigscheme/sigschemetype.h
  - (SCM_FUNC_CFUNC): renamed from SCM_FUNC_FUNC
  - (SCM_FUNC_SET_FUNC): renamed from SCM_FUNC_SET_FUNC


Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c	2005-08-23 15:04:21 UTC (rev 1294)
+++ branches/r5rs/sigscheme/datas.c	2005-08-24 04:42:03 UTC (rev 1295)
@@ -680,7 +680,7 @@
 
     SCM_ENTYPE_FUNC(obj);
     SCM_FUNC_SET_NUMARG(obj, num_arg);
-    SCM_FUNC_SET_FUNC(obj, func);
+    SCM_FUNC_SET_CFUNC(obj, func);
 
     return obj;
 }

Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2005-08-23 15:04:21 UTC (rev 1294)
+++ branches/r5rs/sigscheme/operations.c	2005-08-24 04:42:03 UTC (rev 1295)
@@ -188,21 +188,29 @@
             return SCM_TRUE;
         break;
 
-    case ScmSymbol:  /* equivalent symbols must already be true on eq? */
+    case ScmSymbol: /* equivalent symbols must already be true on EQ */
         break;
 
-    /* ScmFunc, ScmClosure, ScmPort, ScmContinuation comparison is not unspecified in R5RS */
     case ScmFunc:
-        SigScm_ErrorObj("equal? : cannot compare function : ", Scm_NewCons(obj1, obj2));
+        if (EQ(SCM_FUNC_CFUNC(obj1), SCM_FUNC_CFUNC(obj2)))
+            return SCM_TRUE;
         break;
+
     case ScmClosure:
-        SigScm_ErrorObj("equal? : cannot compare function : ", Scm_NewCons(obj1, obj2));
+        if (EQ(SCM_CLOSURE_EXP(obj1), SCM_CLOSURE_EXP(obj2))
+            && EQ(SCM_CLOSURE_ENV(obj1), SCM_CLOSURE_ENV(obj2)))
+            return SCM_TRUE;
         break;
+
     case ScmPort:
-        SigScm_ErrorObj("equal? : cannot compare function : ", Scm_NewCons(obj1, obj2));
+        if (EQ(SCM_PORT_PORTDIRECTION(obj1), SCM_PORT_PORTDIRECTION(obj2))
+            && EQ(SCM_PORT_PORTINFO(obj1), SCM_PORT_PORTINFO(obj2)))
+            return SCM_TRUE;
         break;
+
     case ScmContinuation:
-        SigScm_ErrorObj("equal? : cannot compare function : ", Scm_NewCons(obj1, obj2));
+        if (EQ(SCM_CONTINUATION_CONTINFO(obj1), SCM_CONTINUATION_CONTINFO(obj2)))
+            return SCM_TRUE;
         break;
 
     case ScmValuePacket:

Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h	2005-08-23 15:04:21 UTC (rev 1294)
+++ branches/r5rs/sigscheme/sigschemetype.h	2005-08-24 04:42:03 UTC (rev 1295)
@@ -272,8 +272,8 @@
 #define SCM_ENTYPE_FUNC(a)     (SCM_ENTYPE((a), ScmFunc))
 #define SCM_FUNC_NUMARG(a) (SCM_FUNC(a)->obj.func.num_arg)
 #define SCM_FUNC_SET_NUMARG(a, numarg) (SCM_FUNC_NUMARG(a) = (numarg))
-#define SCM_FUNC_FUNC(a)   (SCM_FUNC(a)->obj.func.subrs.subr0.func)
-#define SCM_FUNC_SET_FUNC(a, func)     (SCM_FUNC_FUNC(a) = (ScmFuncType)(func))
+#define SCM_FUNC_CFUNC(a)   (SCM_FUNC(a)->obj.func.subrs.subr0.func)
+#define SCM_FUNC_SET_CFUNC(a, func)     (SCM_FUNC_CFUNC(a) = (ScmFuncType)(func))
 
 #define SCM_FUNC_EXEC_SUBR0(a)                               ((*(a)->obj.func.subrs.subr0.func) ())
 #define SCM_FUNC_EXEC_SUBR1(a, arg1)                         ((*(a)->obj.func.subrs.subr1.func) (arg1))