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

[kzk at freedesktop.org]

Author: kzk
Date: 2005-08-12 01:21:58 -0700 (Fri, 12 Aug 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	2005-08-12 04:31:01 UTC (rev 1187)
+++ branches/r5rs/sigscheme/eval.c	2005-08-12 08:21:58 UTC (rev 1188)
@@ -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	2005-08-12 04:31:01 UTC (rev 1187)
+++ branches/r5rs/sigscheme/operations.c	2005-08-12 08:21:58 UTC (rev 1188)
@@ -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,12 +926,17 @@
 
 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,20 +956,42 @@
     return SCM_NIL;
 }
 
-ScmObj ScmOp_length(ScmObj obj)
+/*
+ * Notice
+ *
+ * This function is ported from Gauche, by Shiro Kawai(shiro at acm.org)
+ */
+int ScmOp_c_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);
+    ScmObj slow = obj;
+    int len = 0;
 
-        length++;
+    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)
 {
     ScmObj head_tail = SCM_NIL;