fix mapcar function.

diff --git a/modules/ml-struct.cc b/modules/ml-struct.cc
index eba67f9..4950172 100644 (file)
--- a/modules/ml-struct.cc
+++ b/modules/ml-struct.cc
@@ -947,7 +947,7 @@ MNode*  ml_append (MNode* cell, MlEnv* mlenv) {
 
 /*DOC:
 ===mapcar===
- (mapcar LAMBDA LIST) -> LIST
+ (mapcar LAMBDA LIST...) -> LIST
 
 */
 //#AFUNC       mapcar  ml_mapcar
@@ -955,18 +955,19 @@ MNode*  ml_append (MNode* cell, MlEnv* mlenv) {
 MNode*  ml_mapcar (MNode* cell, MlEnv* mlenv) {
     MNode*  arg = cell->cdr ();
     MNodePtr  fn;
-    MNodePtr  list;
+    MNodeList  list;
     MNodeList  ans;
     MNodePtr  h;
+    bool  f;
 
     if (! arg)
        throw (uErrorWrongNumber);
     fn = eval (arg->car (), mlenv);
     nextNodeNonNil (arg);
-    list = eval (arg->car (), mlenv);
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
+    while (arg) {
+       list.append (eval (arg->car (), mlenv));
+       nextNode (arg);
+    }
 
     if (! fn ()) {
        throw (uErrorSyntax);
@@ -975,34 +976,62 @@ MNode*  ml_mapcar (MNode* cell, MlEnv* mlenv) {
     } else {
        throw (uErrorSyntax);
     }
+    if (isNil (list ()))
+       return NULL;
 
-    arg = list ();
     if (fn ()->isSym ()) {
-       h = new MNode ();
-       h ()->set_car (fn ());
-       MNode*  q = new MNode ();
-       h ()->set_cdr (q);
-       q->set_car (NULL);
-       while (arg) {
-           q->unset_car ();
-           q->set_car (eval (arg->car (), mlenv));
-           nextNode (arg);
+       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 ());
            ans.append (eval (h (), mlenv));
        }
     } else {
-       while (arg) {
-           h = new MNode;
-           h ()->set_car (arg->car ());
-           nextNode (arg);
-           ans.append (execDefun (mlenv, fn (), h (), uEmpty));
+       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;
+           ans.append (execDefun (mlenv, fn (), e (), uEmpty));
        }
     }
+
     return ans.release ();
 }
 
 /*DOC:
 ===mapcar-collect===
- (mapcar-collect LAMBDA LIST) -> LIST
+ (mapcar-collect LAMBDA LIST...) -> LIST
 
 */
 //#AFUNC       mapcar-collect  ml_mapcar_collect
@@ -1010,19 +1039,20 @@ MNode*  ml_mapcar (MNode* cell, MlEnv* mlenv) {
 MNode*  ml_mapcar_collect (MNode* cell, MlEnv* mlenv) {
     MNode*  arg = cell->cdr ();
     MNodePtr  fn;
-    MNodePtr  list;
+    MNodeList  list;
     MNodeList  ans;
     MNodePtr  h;
     MNodePtr  v;
+    bool  f;
 
     if (! arg)
        throw (uErrorWrongNumber);
     fn = eval (arg->car (), mlenv);
-    nextNode (arg);
-    list = eval (arg->car (), mlenv);
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
+    nextNodeNonNil (arg);
+    while (arg) {
+       list.append (eval (arg->car (), mlenv));
+       nextNode (arg);
+    }
 
     if (! fn ()) {
        throw (uErrorSyntax);
@@ -1031,35 +1061,98 @@ MNode*  ml_mapcar_collect (MNode* cell, MlEnv* mlenv) {
     } else {
        throw (uErrorSyntax);
     }
+    if (isNil (list ()))
+       return NULL;
 
-    arg = list ();
     if (fn ()->isSym ()) {
-       h = new MNode ();
-       h ()->set_car (fn ());
-       MNode*  q = new MNode ();
-       h ()->set_cdr (q);
-       q->set_car (NULL);
-       while (arg) {
-           q->unset_car ();
-           q->set_car (eval (arg->car (), mlenv));
-           nextNode (arg);
+       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 ())
                ans.append (v.release ());
        }
     } else {
-       while (arg) {
-           h = new MNode;
-           h ()->set_car (arg->car ());
-           nextNode (arg);
-           v = execDefun (mlenv, fn (), h (), uEmpty);
+       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 ())
                ans.append (v.release ());
        }
     }
+
     return ans.release ();
 }
 
+
+
+/*DOC:
+===member===
+ (member ELT LIST) -> LIST
+
+Return 1 if LIST contaions ELT. The comparison is done by ===.
+
+*/
+//#AFUNC       member  ml_member
+//#WIKIFUNC    member
+MNode*  ml_member (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  elt;
+    MNodePtr  list;
+
+    if (! arg)
+       throw (uErrorWrongNumber);
+    elt = eval (arg->car (), mlenv);
+    nextNode (arg);
+    list = eval (arg->car (), mlenv);
+    nextNode (arg);
+    if (arg)
+       throw (uErrorWrongNumber);
+
+    arg = list ();
+    while (arg) {
+       if (eq (elt (), arg->car ())) {
+           return newMNode_bool (true);
+       }
+       nextNode (arg);
+    }
+    return NULL;
+}
+
 /*DOC:
 ===memberp===
  (memberp LAMBDA LIST) -> LIST

diff --git a/modules/ml-struct.h b/modules/ml-struct.h
index be69bfd..5b61365 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_member (MNode* cell, MlEnv* mlenv);
 MNode*  ml_memberp (MNode* cell, MlEnv* mlenv);
 MNode*  ml_reverse (MNode* cell, MlEnv* mlenv);