mapcar-concat function.

diff --git a/modules/ml-struct.cc b/modules/ml-struct.cc
index d580c10..74387bb 100644 (file)
--- a/modules/ml-struct.cc
+++ b/modules/ml-struct.cc
@@ -1189,7 +1189,7 @@ MNode*  ml_mapcar_append (MNode* cell, MlEnv* mlenv) {
                    nextNode (a);
                }
            } else {
-               ans.append (v.release ());
+               ans.append (v.release ());      // XXX: hack
            }
        }
     } else {
@@ -1220,6 +1220,99 @@ MNode*  ml_mapcar_append (MNode* cell, MlEnv* mlenv) {
                    nextNode (a);
                }
            } else {
+               ans.append (v.release ());      // XXX: hack
+           }
+       }
+    }
+
+    return ans.release ();
+}
+
+/*DOC:
+===mapcar-concat===
+ (mapcar-concat LAMBDA LIST...) -> LIST
+
+*/
+//#AFUNC       mapcar-concat   ml_mapcar_concat
+//#WIKIFUNC    mapcar-concat
+MNode*  ml_mapcar_concat (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  fn;
+    MNodeList  list;
+    MNodeList  ans;
+    MNodePtr  h;
+    MNodePtr  v;
+    bool  f;
+
+    if (! arg)
+       throw (uErrorWrongNumber);
+    fn = eval (arg->car (), mlenv);
+    nextNodeNonNil (arg);
+    while (arg) {
+       list.append (eval (arg->car (), mlenv));
+       nextNode (arg);
+    }
+
+    if (! fn ()) {
+       throw (uErrorSyntax);
+    } else if (isLambda (fn ())) {
+    } else if (fn ()->isSym ()) {
+    } else {
+       throw (uErrorSyntax);
+    }
+    if (isNil (list ()))
+       return NULL;
+
+    if (fn ()->isSym ()) {
+       while (1) {
+           MNodeList  e;
+           arg = list ();
+           f = false;
+           while (arg) {
+               h = arg->car ();
+               if (h () && h ()->isCons ()) {
+                   e.append (newMNode_quote (h ()->car ()));
+                   arg->unset_car ();
+                   arg->set_car (h ()->cdr ());
+                   f = true;
+               } else {
+                   e.append (NULL);
+               }
+               nextNode (arg);
+           }
+           if (! f)
+               break;
+           h = new MNode ();
+           h ()->set_car (fn ());
+           h ()->set_cdr (e.release ());
+           v = eval (h (), mlenv);
+           if (! v ()) {
+           } else {
+               ans.append (v.release ());
+           }
+       }
+    } else {
+       while (1) {
+           MNodeList  e;
+           arg = list ();
+           f = false;
+           while (arg) {
+               h = arg->car ();
+               if (h () && h ()->isCons ()) {
+                   e.append (h ()->car ());
+                   arg->unset_car ();
+                   arg->set_car (h ()->cdr ());
+                   f = true;
+               } else {
+                   e.append (NULL);
+               }
+               nextNode (arg);
+           }
+           if (! f)
+               break;
+           v = execDefun (mlenv, fn (), e (), uEmpty);
+           if (! v ()) {
+           } else {
                ans.append (v.release ());
            }
        }

diff --git a/modules/ml-struct.h b/modules/ml-struct.h
index eb84fa1..8e15a80 100644 (file)
--- a/modules/ml-struct.h
+++ b/modules/ml-struct.h
@@ -31,6 +31,7 @@ MNode*  ml_append (MNode* cell, MlEnv* mlenv);
 MNode*  ml_mapcar (MNode* cell, MlEnv* mlenv);
 MNode*  ml_mapcar_collect (MNode* cell, MlEnv* mlenv);
 MNode*  ml_mapcar_append (MNode* cell, MlEnv* mlenv);
+MNode*  ml_mapcar_concat (MNode* cell, MlEnv* mlenv);
 MNode*  ml_member (MNode* cell, MlEnv* mlenv);
 MNode*  ml_memberp (MNode* cell, MlEnv* mlenv);
 MNode*  ml_reverse (MNode* cell, MlEnv* mlenv);