mapcar-append function.

diff --git a/modules/ml-struct.cc b/modules/ml-struct.cc
index e85feed..d580c10 100644 (file)
--- a/modules/ml-struct.cc
+++ b/modules/ml-struct.cc
@@ -1123,7 +1123,110 @@ MNode*  ml_mapcar_collect (MNode* cell, MlEnv* mlenv) {
     return ans.release ();
 }
 
+/*DOC:
+===mapcar-append===
+ (mapcar-append LAMBDA LIST...) -> LIST
+
+*/
+//#AFUNC       mapcar-append   ml_mapcar_append
+//#WIKIFUNC    mapcar-append
+MNode*  ml_mapcar_append (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 if (v ()->isCons ()) {
+               MNode*  a = v ();
+               while (a) {
+                   ans.append (a->car ());
+                   nextNode (a);
+               }
+           } 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 if (v ()->isCons ()) {
+               MNode*  a = v ();
+               while (a) {
+                   ans.append (a->car ());
+                   nextNode (a);
+               }
+           } else {
+               ans.append (v.release ());
+           }
+       }
+    }
 
+    return ans.release ();
+}
 
 /*DOC:
 ===member===

diff --git a/modules/ml-struct.h b/modules/ml-struct.h
index 7160d60..eb84fa1 100644 (file)
--- a/modules/ml-struct.h
+++ b/modules/ml-struct.h
@@ -30,6 +30,7 @@ MNode*  ml_cons (MNode* cell, MlEnv* mlenv);
 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_member (MNode* cell, MlEnv* mlenv);
 MNode*  ml_memberp (MNode* cell, MlEnv* mlenv);
 MNode*  ml_reverse (MNode* cell, MlEnv* mlenv);