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

[kzk at freedesktop.org]

Author: kzk
Date: 2005-08-31 15:03:35 -0700 (Wed, 31 Aug 2005)
New Revision: 1369

Modified:
   branches/r5rs/sigscheme/operations-siod.c
   branches/r5rs/sigscheme/sigscheme.c
   branches/r5rs/sigscheme/sigscheme.h
Log:
* add SIOD compatible "="

* sigscheme/sigscheme.c
  - (SigScm_initialize): export "=" as ScmOp_siod_eql when
    SCM_COMPAT_SIOD is enabled
* sigscheme/sigscheme.h
* sigscheme/operations-siod.c
  - (ScmOp_siod_eql): new func


Modified: branches/r5rs/sigscheme/operations-siod.c
===================================================================
--- branches/r5rs/sigscheme/operations-siod.c	2005-08-31 21:45:47 UTC (rev 1368)
+++ branches/r5rs/sigscheme/operations-siod.c	2005-08-31 22:03:35 UTC (rev 1369)
@@ -94,6 +94,20 @@
     return SCM_SYMBOL_SET_VCELL(var, val);
 }
 
+ScmObj ScmOp_siod_eql(ScmObj obj1, ScmObj obj2)
+{
+    if (EQ(obj1, obj2))
+        return SCM_TRUE;
+    else if (!INTP(obj1))
+        return SCM_FALSE;
+    else if (!INTP(obj2))
+        return SCM_FALSE;
+    else if (SCM_INT_VALUE(obj1) == SCM_INT_VALUE(obj2))
+        return SCM_TRUE;
+
+    return SCM_FALSE;
+}
+
 ScmObj ScmOp_bit_and(ScmObj obj1, ScmObj obj2)
 {
     if (!INTP(obj1))

Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c	2005-08-31 21:45:47 UTC (rev 1368)
+++ branches/r5rs/sigscheme/sigscheme.c	2005-08-31 22:03:35 UTC (rev 1369)
@@ -334,13 +334,14 @@
     Scm_RegisterFunc1("symbol-bound?"        , ScmOp_symbol_boundp);
     Scm_RegisterFunc1("symbol-value"         , ScmOp_symbol_value);
     Scm_RegisterFunc2("set-symbol-value!"    , ScmOp_set_symbol_value);
+    Scm_RegisterFunc2("="                    , ScmOp_siod_eql);
     Scm_RegisterFunc2("bit-and"              , ScmOp_bit_and);
     Scm_RegisterFunc2("bit-or"               , ScmOp_bit_or);
     Scm_RegisterFunc2("bit-xor"              , ScmOp_bit_xor);
     Scm_RegisterFunc1("bit-not"              , ScmOp_bit_not);
-    Scm_RegisterFuncEvaledList("the-environment"      , ScmOp_the_environment);
-    Scm_RegisterFunc1("%%closure-code"       , ScmOp_closure_code);
-    Scm_RegisterFuncEvaledList("verbose"              , ScmOp_verbose);
+    Scm_RegisterFuncEvaledList("the-environment" , ScmOp_the_environment);
+    Scm_RegisterFunc1("%%closure-code"           , ScmOp_closure_code);
+    Scm_RegisterFuncEvaledList("verbose"         , ScmOp_verbose);
     /* datas.c */
     scm_return_value = SCM_NULL;
 #endif

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-08-31 21:45:47 UTC (rev 1368)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-08-31 22:03:35 UTC (rev 1369)
@@ -360,6 +360,7 @@
 ScmObj ScmOp_symbol_boundp(ScmObj obj);
 ScmObj ScmOp_symbol_value(ScmObj var);
 ScmObj ScmOp_set_symbol_value(ScmObj var, ScmObj val);
+ScmObj ScmOp_siod_eql(ScmObj obj1, ScmObj obj2);
 ScmObj ScmOp_bit_and(ScmObj obj1, ScmObj obj2);
 ScmObj ScmOp_bit_or(ScmObj obj1, ScmObj obj2);
 ScmObj ScmOp_bit_xor(ScmObj obj1, ScmObj obj2);