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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-06 14:46:18 -0800 (Fri, 06 Jan 2006)
New Revision: 2816

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* sigscheme/sigscheme.h
  - (scm_finite_length): New function decl
* sigscheme/operations.c
  - (scm_finite_length): New function
* sigscheme/eval.c
  - (call_closure): Make efficient with scm_finite_length()


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2006-01-06 22:33:01 UTC (rev 2815)
+++ branches/r5rs/sigscheme/eval.c	2006-01-06 22:46:18 UTC (rev 2816)
@@ -211,7 +211,9 @@
          *
          *  - dotted list is handled in env.c
          */
-        formals_len = scm_length(formals); /* can skip full validation */
+        /* scm_finite_length() is enough since formals is fully validated
+         * previously */
+        formals_len = scm_finite_length(formals);
         if (!scm_valid_environment_extension_lengthp(formals_len, args_len))
             goto err_improper;
 

Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2006-01-06 22:33:01 UTC (rev 2815)
+++ branches/r5rs/sigscheme/operations.c	2006-01-06 22:46:18 UTC (rev 2816)
@@ -796,6 +796,23 @@
     return MAKE_BOOL(len >= 0);
 }
 
+#define TERMINATOR_LEN 1
+
+/* scm_length() for non-circular list */
+int
+scm_finite_length(ScmObj lst)
+{
+    int len;
+
+    for (len = 0; CONSP(lst); lst = CDR(lst))
+        len++;
+
+    if (NULLP(lst))
+        return len;
+    else
+        return SCM_LISTLEN_ENCODE_DOTTED(len + TERMINATOR_LEN);
+}
+
 /*
  * Notice
  *
@@ -815,8 +832,6 @@
     ScmObj slow;
     int proper_len;
 
-#define TERMINATOR_LEN 1
-
     for (proper_len = 0, slow = lst;;) {
         if (NULLP(lst)) break;
         if (!CONSP(lst))
@@ -838,9 +853,10 @@
     }
 
     return proper_len;
-#undef TERMINATOR_LEN
 }
 
+#undef TERMINATOR_LEN
+
 ScmObj
 scm_p_length(ScmObj obj)
 {

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2006-01-06 22:33:01 UTC (rev 2815)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2006-01-06 22:46:18 UTC (rev 2816)
@@ -508,6 +508,7 @@
                    ScmObj obj) SCM_NORETURN;
 
 /* operations.c */
+int scm_finite_length(ScmObj lst);
 int scm_length(ScmObj lst);
 
 /* io.c */