[uim commit] r1188 - branches/r5rs/sigscheme

[codesite-noreply]

Author: kzk
Date: Fri Aug 12 01:21:58 2005
New Revision: 1188

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/operations.c

Log:
* sigscheme/eval.c
  - (extend_environment): accept NULL vars and vals
* sigscheme/operations.c
  - (ScmOp_c_length): new func ported from Gauche
  - (ScmOp_length, ScmOp_listp): support circular list check


Modified: branches/r5rs/sigscheme/eval.c
==============================================================================
--- branches/r5rs/sigscheme/eval.c      (original)
+++ branches/r5rs/sigscheme/eval.c      Fri Aug 12 01:21:58 2005
@@ -89,10 +89,6 @@
 {
     ScmObj frame = SCM_NIL;
 
-    /* sanity check */
-    if (SCM_NULLP(vars) && SCM_NULLP(vals))
-       return env;
-
     /* create new frame */
     frame   = Scm_NewCons(vars, vals);
 

Modified: branches/r5rs/sigscheme/operations.c
==============================================================================
--- branches/r5rs/sigscheme/operations.c        (original)
+++ branches/r5rs/sigscheme/operations.c        Fri Aug 12 01:21:58 2005
@@ -59,6 +59,7 @@
   File Local Function Declarations
 =======================================*/
 static ScmObj list_gettail(ScmObj head);
+static int ScmOp_c_length(ScmObj list);
 static ScmObj ScmOp_listtail_internal(ScmObj obj, int k);
 static ScmObj ScmOp_append_internal(ScmObj head, ScmObj tail);
 
@@ -925,11 +926,16 @@
 
 ScmObj ScmOp_listp(ScmObj obj)
 {
-    for (; !SCM_NULLP(obj); obj = SCM_CDR(obj)) {
-        /* check if valid list */
-        if (!SCM_CONSP(obj))
-            return SCM_FALSE;
-    }
+    int len = 0;
+
+    if (SCM_NULLP(obj))
+       return SCM_TRUE;
+    if (!SCM_CONSP(obj))
+       return SCM_FALSE;
+
+    len = ScmOp_c_length(obj);
+    if (len == -1)
+       return SCM_FALSE;
 
     return SCM_TRUE;
 }
@@ -950,18 +956,40 @@
     return SCM_NIL;
 }
 
-ScmObj ScmOp_length(ScmObj obj)
-{
-    int length = 0;
-    for (; !SCM_NULLP(obj); obj = SCM_CDR(obj)) {
-        /* check if valid list */
-        if (!SCM_NULLP(obj) && !SCM_CONSP(obj))
-            SigScm_ErrorObj("length : bad list. given obj contains ", obj);
-
-        length++;
+/*
+ * Notice
+ *
+ * This function is ported from Gauche, by Shiro Kawai([EMAIL PROTECTED])
+ */
+int ScmOp_c_length(ScmObj obj)
+{
+    ScmObj slow = obj;
+    int len = 0;
+
+    if (SCM_NULLP(obj)) return 0;
+
+    for (;;) {
+        if (SCM_NULLP(obj)) break;
+        if (!SCM_CONSP(obj)) return -1;
+       if (len != 0 && obj == slow) return -1; /* circular */
+       
+       obj = SCM_CDR(obj);
+       len++;
+        if (SCM_NULLP(obj)) break;
+        if (!SCM_CONSP(obj)) return -1;
+       if (obj == slow) return -1; /* circular */
+
+       obj = SCM_CDR(obj);
+       slow = SCM_CDR(slow);
+       len++;
     }
 
-    return Scm_NewInt(length);
+    return len;
+}
+
+ScmObj ScmOp_length(ScmObj obj)
+{
+    return Scm_NewInt(ScmOp_c_length(obj));
 }
 
 ScmObj ScmOp_append_internal(ScmObj head, ScmObj tail)