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

[kzk at freedesktop.org]

Author: kzk
Date: 2005-09-28 08:07:56 -0700 (Wed, 28 Sep 2005)
New Revision: 1666

Modified:
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigscheme.c
   branches/r5rs/sigscheme/sigscheme.h
Log:
* simplify "ScmOp_map" and "ScmOp_for_each" by
  Scm_RegisterProcedureVariadic1

* sigscheme/operations.c
* sigscheme/sigscheme.h
  - (ScmOp_map, ScmOp_for_each): change args
* sigscheme/sigscheme.c
  - export "map" and "for-each" as Scm_RegisterProcedureVariadic1



Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2005-09-28 15:06:19 UTC (rev 1665)
+++ branches/r5rs/sigscheme/operations.c	2005-09-28 15:07:56 UTC (rev 1666)
@@ -1719,26 +1719,18 @@
     return (FUNCP(obj) || CLOSUREP(obj)) ? SCM_TRUE : SCM_FALSE;
 }
 
-/*
- * FIXME:
- * - Simplify with Scm_RegisterProcedureVariadic1
- * - Replace expensive 'length' operation with CDR and NULLP
- */
-ScmObj ScmOp_map(ScmObj args, ScmObj env)
+ScmObj ScmOp_map(ScmObj proc, ScmObj args)
 {
-    ScmObj proc = CAR(args);
-    int arg_len = SCM_INT_VALUE(ScmOp_length(args));
+     /* sanity check */
+    if (NULLP(args))
+        SigScm_Error("map : wrong number of arguments");
 
-    /* arglen check */
-    if (arg_len < 2)
-        SigScm_Error("map : Wrong number of arguments");
-
     /* fast path for sinble arg case */
-    if (arg_len == 2)
-        return map_single_arg(proc, CADR(args));
+    if (NULLP(CDR(args)))
+        return map_single_arg(proc, CAR(args));
 
     /* multiple args case */
-    return map_multiple_args(proc, CDR(args));
+    return map_multiple_args(proc, args);
 }
 
 static ScmObj map_single_arg(ScmObj proc, ScmObj lst)
@@ -1818,9 +1810,9 @@
     return SCM_NULL;
 }
 
-ScmObj ScmOp_for_each(ScmObj arg, ScmObj env)
+ScmObj ScmOp_for_each(ScmObj proc, ScmObj args)
 {
-    ScmOp_map(arg, env);
+    ScmOp_map(proc, args);
 
     return SCM_UNDEF;
 }

Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c	2005-09-28 15:06:19 UTC (rev 1665)
+++ branches/r5rs/sigscheme/sigscheme.c	2005-09-28 15:07:56 UTC (rev 1666)
@@ -291,8 +291,8 @@
     Scm_RegisterFunc1("list->vector"             , ScmOp_list2vector);
     Scm_RegisterFunc2("vector-fill!"             , ScmOp_vector_fill);
     Scm_RegisterFunc1("procedure?"               , ScmOp_procedurep);
-    Scm_RegisterFuncEvaledList("map"             , ScmOp_map);
-    Scm_RegisterFuncEvaledList("for-each"        , ScmOp_for_each);
+    Scm_RegisterProcedureVariadic1("map"         , ScmOp_map);
+    Scm_RegisterProcedureVariadic1("for-each"    , ScmOp_for_each);
     Scm_RegisterFuncEvaledList("force"           , ScmOp_force);
     Scm_RegisterFuncEvaledList("values"          , ScmOp_values);
     Scm_RegisterFuncEvaledList("call-with-current-continuation", ScmOp_call_with_current_continuation);

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-09-28 15:06:19 UTC (rev 1665)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-09-28 15:07:56 UTC (rev 1666)
@@ -515,8 +515,8 @@
 ScmObj ScmOp_list2vector(ScmObj lst);
 ScmObj ScmOp_vector_fill(ScmObj vec, ScmObj fill);
 ScmObj ScmOp_procedurep(ScmObj obj);
-ScmObj ScmOp_map(ScmObj map_arg, ScmObj env);
-ScmObj ScmOp_for_each(ScmObj arg, ScmObj env);
+ScmObj ScmOp_map(ScmObj proc, ScmObj args);
+ScmObj ScmOp_for_each(ScmObj proc, ScmObj args);
 ScmObj ScmOp_force(ScmObj arg, ScmObj env);
 ScmObj ScmOp_call_with_current_continuation(ScmObj arg, ScmObj env);
 ScmObj ScmOp_values(ScmObj argl, ScmObj env);