/*DOC:
===mapcar===
- (mapcar LAMBDA LIST) -> LIST
+ (mapcar LAMBDA LIST...) -> LIST
*/
//#AFUNC mapcar ml_mapcar
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);
} 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
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);
} 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