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

[kzk at freedesktop.org]

Author: kzk
Date: 2005-09-28 01:08:16 -0700 (Wed, 28 Sep 2005)
New Revision: 1635

Modified:
   branches/r5rs/sigscheme/TODO
   branches/r5rs/sigscheme/operations.c
Log:
* optimize "map", not to use "reverse" and "vector"

* sigscheme/operations.c
  - (ScmOp_map): split content into map_singular_arg and
    map_plural_args
  - (map_singular_arg, map_plural_args): new func
* sigscheme/TODO
  - update


Modified: branches/r5rs/sigscheme/TODO
===================================================================
--- branches/r5rs/sigscheme/TODO	2005-09-28 07:14:02 UTC (rev 1634)
+++ branches/r5rs/sigscheme/TODO	2005-09-28 08:08:16 UTC (rev 1635)
@@ -36,8 +36,6 @@
 ==============================================================================
 Performance improvements:
 
-* Optimize ScmOp_map()
-
 * Object representation compaction ([Anthy-dev 2353], [Anthy-dev 2360])
 
 * Replace almost ScmObj initialization by SCM_NULL with SCM_FALSE. SCM_NULL is

Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2005-09-28 07:14:02 UTC (rev 1634)
+++ branches/r5rs/sigscheme/operations.c	2005-09-28 08:08:16 UTC (rev 1635)
@@ -63,6 +63,9 @@
 static int ScmOp_c_length(ScmObj lst);
 static ScmObj ScmOp_listtail_internal(ScmObj obj, int k);
 
+static ScmObj map_singular_arg(ScmObj proc, ScmObj args);
+static ScmObj map_plural_args(ScmObj proc, ScmObj args);
+
 /*=======================================
   Function Implementations
 =======================================*/
@@ -1716,61 +1719,92 @@
     return (FUNCP(obj) || CLOSUREP(obj)) ? SCM_TRUE : SCM_FALSE;
 }
 
-/* FIXME: excessive memory consumptions (reverse, vector) */
-ScmObj ScmOp_map(ScmObj map_arg, ScmObj env)
+ScmObj ScmOp_map(ScmObj args, ScmObj env)
 {
-    int arg_len = SCM_INT_VALUE(ScmOp_length(map_arg));
-    ScmObj proc = CAR(map_arg);
-    ScmObj args = SCM_NULL;
-    ScmObj ret  = SCM_NULL;
-    ScmObj tmp  = SCM_NULL;
+    ScmObj proc = CAR(args);
+    int arg_len = SCM_INT_VALUE(ScmOp_length(args));
 
-    ScmObj arg_vector = SCM_NULL;
-    ScmObj arg1       = SCM_NULL;
-    int vector_len = 0;
-    int i = 0;
-
     /* arglen check */
     if (arg_len < 2)
         SigScm_Error("map : Wrong number of arguments");
 
     /* 1proc and 1arg case */
-    if (arg_len == 2) {
-        /* apply func to each item */
-        for (args = CADR(map_arg); !NULLP(args); args = CDR(args)) {
-            /* apply proc */
-            ret = CONS(Scm_call(proc, LIST_1(CAR(args))), ret);
+    if (arg_len == 2)
+        return map_singular_arg(proc, CADR(args));
+
+    /* 1proc and many args case */
+    return map_plural_args(proc, CDR(args));
+}
+
+static ScmObj map_singular_arg(ScmObj proc, ScmObj args)
+{
+    ScmObj ret      = SCM_NULL;
+    ScmObj ret_tail = SCM_FALSE;
+
+    if (NULLP(args))
+        return SCM_NULL;
+
+    for (; !NULLP(args); args = CDR(args)) {
+        if (NFALSEP(ret)) {
+            /* lasting */
+            SET_CDR(ret_tail, CONS(Scm_call(proc, LIST_1(CAR(args))), SCM_NULL));
+            ret_tail = CDR(ret_tail);
+
+        } else {
+            /* first */
+            ret = CONS(Scm_call(proc, LIST_1(CAR(args))), SCM_NULL);
+            ret_tail = ret;
         }
-        return ScmOp_reverse(ret);
     }
 
-    /* 1proc and many args case */
-    arg_vector = ScmOp_list2vector(CDR(map_arg));
-    vector_len = SCM_VECTOR_LEN(arg_vector);
+    return ret;
+}
+
+static ScmObj map_plural_args(ScmObj proc, ScmObj args)
+{
+    ScmObj map_arg      = SCM_FALSE;
+    ScmObj map_arg_tail = SCM_FALSE;
+    ScmObj tmp_lsts     = SCM_FALSE;
+    ScmObj lst          = SCM_FALSE;
+    ScmObj ret          = SCM_FALSE;
+    ScmObj ret_tail     = SCM_FALSE;
+
     while (1) {
-        /* create arg */
-        arg1 = SCM_NULL;
-        for (i = 0; i < vector_len; i++) {
-            tmp  = SCM_VECTOR_CREF(arg_vector, i);
-            /* check if we can continue next loop */
-            if (NULLP(tmp)) {
-                /* if next item is SCM_NULL, let's return! */
-                return ScmOp_reverse(ret);
+        /* construct map_arg */
+        map_arg  = SCM_NULL;
+        tmp_lsts = args;
+        for (; !NULLP(tmp_lsts); tmp_lsts = CDR(tmp_lsts)) {
+            lst = CAR(tmp_lsts);
+            if (NULLP(lst))
+                return ret;
+
+            if (NFALSEP(map_arg)) {
+                /* lasting */
+                SET_CDR(map_arg_tail, CONS(CAR(lst), SCM_NULL));
+                map_arg_tail = CDR(map_arg_tail);
+            } else {
+                /* first */
+                map_arg = CONS(CAR(lst), SCM_NULL);
+                map_arg_tail = map_arg;
             }
 
-            arg1 = CONS(CAR(tmp), arg1);
-            SCM_VECTOR_SET_CREF(arg_vector, i, CDR(tmp));
+            /* update tmp_lsts */
+            SET_CAR(tmp_lsts, CDR(lst));
         }
 
-        /* reverse arg */
-        arg1 = ScmOp_reverse(arg1);
-
-        /* apply proc to arg1 */
-        ret = CONS(Scm_call(proc, arg1), ret);
+        /* construct ret */
+        if (NFALSEP(ret)) {
+            /* lasting */
+            SET_CDR(ret_tail, CONS(Scm_call(proc, map_arg), SCM_NULL));
+            ret_tail = CDR(ret_tail);
+        } else {
+            /* first */
+            ret = CONS(Scm_call(proc, map_arg), SCM_NULL);
+            ret_tail = ret;
+        }
     }
 
-    /* never reaches here */
-    SigScm_Error("map bug?");
+    SigScm_Error("map : invalid argument ", args);
     return SCM_NULL;
 }