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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-06 15:30:22 -0800 (Fri, 06 Jan 2006)
New Revision: 2820

Modified:
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigschemeinternal.h
   branches/r5rs/sigscheme/syntax.c
Log:
* sigscheme/sigschemeinternal.h
  - (ENSURE_PROPER_ARG_LIST): Simplify with PROPER_LISTP()
* sigscheme/operations.c
  - (scm_p_listp): Ditto
  - (scm_p_length):
    * Simplify with SCM_LISTLEN_PROPERP()
    * Fix error message
  - (scm_p_list2vector): Simplify with SCM_LISTLEN_PROPERP()
* sigscheme/syntax.c
  - (vectran): Ditto


Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2006-01-06 23:17:49 UTC (rev 2819)
+++ branches/r5rs/sigscheme/operations.c	2006-01-06 23:30:22 UTC (rev 2820)
@@ -783,17 +783,15 @@
 ScmObj
 scm_p_listp(ScmObj obj)
 {
-    int len;
     DECLARE_FUNCTION("list?", procedure_fixed_1);
 
+    /* fast path */
     if (NULLP(obj))
         return SCM_TRUE;
     if (!CONSP(obj))
         return SCM_FALSE;
 
-    len = scm_length(obj);
-
-    return MAKE_BOOL(len >= 0);
+    return MAKE_BOOL(PROPER_LISTP(obj));
 }
 
 #define TERMINATOR_LEN 1
@@ -864,8 +862,8 @@
     DECLARE_FUNCTION("length", procedure_fixed_1);
 
     len = scm_length(obj);
-    if (len < 0)
-        ERR_OBJ("list required but got", obj);
+    if (!SCM_LISTLEN_PROPERP(len))
+        ERR_OBJ("proper list required but got", obj);
 
     return MAKE_INT(len);
 }
@@ -1682,7 +1680,7 @@
     DECLARE_FUNCTION("list->vector", procedure_fixed_1);
 
     len = scm_length(lst);
-    if (len < 0)
+    if (!SCM_LISTLEN_PROPERP(len))
         ERR_OBJ("proper list required but got", lst);
 
     vec = scm_malloc(sizeof(ScmObj) * len);

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2006-01-06 23:17:49 UTC (rev 2819)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2006-01-06 23:30:22 UTC (rev 2820)
@@ -281,7 +281,7 @@
 #define ENSURE_NO_MORE_ARG(args)                                             \
     (NO_MORE_ARG(args) || (ERR_OBJ("superfluous argument(s)", (args)), 1))
 #define ENSURE_PROPER_ARG_LIST(args)                                         \
-    (scm_length(args) >= 0 || (ERR_OBJ("bad argument list", (args)), 1))
+    (PROPER_LISTP(args) || (ERR_OBJ("bad argument list", (args)), 1))
 #if SCM_STRICT_ARGCHECK
 #define NO_MORE_ARG(args)                                                    \
     (!CONSP(args)                                                            \

Modified: branches/r5rs/sigscheme/syntax.c
===================================================================
--- branches/r5rs/sigscheme/syntax.c	2006-01-06 23:17:49 UTC (rev 2819)
+++ branches/r5rs/sigscheme/syntax.c	2006-01-06 23:30:22 UTC (rev 2820)
@@ -282,7 +282,7 @@
     case TR_MSG_SPLICE:
         splice_len = scm_length(obj);
 #if SCM_STRICT_R5RS
-        if (splice_len < 0)
+        if (!SCM_LISTLEN_PROPERP(splice_len))
             ERR_OBJ("got bad splice list", obj);
 #endif
         t->u.vec.growth += splice_len - 1;