OSDN Git Service

small update.
authorvisor <visor@users.sourceforge.jp>
Thu, 7 Feb 2013 15:15:26 +0000 (00:15 +0900)
committervisor <visor@users.sourceforge.jp>
Thu, 7 Feb 2013 15:15:26 +0000 (00:15 +0900)
modules/ml-bool.cc

index 4d6d496..24e8198 100644 (file)
 
 */
 
-static void  objType (MNode* cell, MlEnv* mlenv, MNodePtr& obj) {
-    MNode*  arg = cell->cdr ();
-
-    if (! arg)
-       throw (uErrorWrongNumber);
-    obj = eval (arg->car (), mlenv);
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
-}
-
 /*DOC:
 ===null, nullp===
- (null VALUE) -> 1 or NIL
- (nullp VALUE) -> 1 or NIL
+ (null VALUE...) -> 1 or NIL
+ (nullp VALUE...) -> 1 or NIL
 
 */
 //#AFUNC       null    ml_nullp
@@ -35,16 +24,24 @@ static void  objType (MNode* cell, MlEnv* mlenv, MNodePtr& obj) {
 //#WIKIFUNC    null
 //#WIKIFUNC    nullp
 MNode*  ml_nullp (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
     MNodePtr  obj;
+    bool  ans = true;
 
-    objType (cell, mlenv, obj);
-    return newMNode_bool (obj () == NULL || obj ()->isNil ());
+    if (! arg)
+       return NULL;            // false
+    while (arg && ans) {
+       obj = eval (arg->car (), mlenv);
+       ans &= isNil (obj ());
+       nextNode (arg);
+    }
+    return newMNode_bool (ans);
 }
 
 /*DOC:
 ===not-null, not-nullp===
- (not-null VALUE) -> 1 or NIL
- (not-nullp VALUE) -> 1 or NIL
+ (not-null VALUE...) -> 1 or NIL
+ (not-nullp VALUE...) -> 1 or NIL
 
 */
 //#AFUNC       not-null        ml_not_nullp
@@ -52,66 +49,106 @@ MNode*  ml_nullp (MNode* cell, MlEnv* mlenv) {
 //#WIKIFUNC    not-null
 //#WIKIFUNC    not-nullp
 MNode*  ml_not_nullp (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
     MNodePtr  obj;
+    bool  ans = true;
 
-    objType (cell, mlenv, obj);
-    return newMNode_bool (obj () != NULL && ! obj ()->isNil ());
+    if (! arg)
+       return NULL;            // false
+    while (arg && ans) {
+       obj = eval (arg->car (), mlenv);
+       ans &= ! isNil (obj ());
+       nextNode (arg);
+    }
+    return newMNode_bool (ans);
 }
 
 /*DOC:
 ===consp===
- (consp VALUE)
+ (consp VALUE...) -> 1 or NIL
 
 */
 //#AFUNC       consp   ml_consp
 //#WIKIFUNC    consp
 MNode*  ml_consp (MNode* cell, MlEnv* mlenv) {
-    MNodePtr  h;
+    MNode*  arg = cell->cdr ();
+    MNodePtr  obj;
+    bool  ans = true;
 
-    objType (cell, mlenv, h);
-    return newMNode_bool (h () && h ()->isCons ());
+    if (! arg)
+       return NULL;            // false
+    while (arg && ans) {
+       obj = eval (arg->car (), mlenv);
+       ans &= (obj () && obj ()->isCons ());
+       nextNode (arg);
+    }
+    return newMNode_bool (ans);
 }
 
 /*DOC:
 ===stringp===
- (stringp VALUE)
+ (stringp VALUE...)
 
 */
 //#AFUNC       stringp ml_stringp
 //#WIKIFUNC    stringp
 MNode*  ml_stringp (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
     MNodePtr  obj;
+    bool  ans = true;
 
-    objType (cell, mlenv, obj);
-    return newMNode_bool (obj () && obj ()->isStr ());
+    if (! arg)
+       return NULL;            // false
+    while (arg && ans) {
+       obj = eval (arg->car (), mlenv);
+       ans &= (obj () && obj ()->isStr ());
+       nextNode (arg);
+    }
+    return newMNode_bool (ans);
 }
 
 /*DOC:
 ===symbolp===
- (symbolp VALUE)
+ (symbolp VALUE...)
 
 */
 //#AFUNC       symbolp ml_symbolp
 //#WIKIFUNC    symbolp
 MNode*  ml_symbolp (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
     MNodePtr  obj;
+    bool  ans = true;
 
-    objType (cell, mlenv, obj);
-    return newMNode_bool (obj () && obj ()->isSym ());
+    if (! arg)
+       return NULL;            // false
+    while (arg && ans) {
+       obj = eval (arg->car (), mlenv);
+       ans &= (obj () && obj ()->isSym ());
+       nextNode (arg);
+    }
+    return newMNode_bool (ans);
 }
 
 /*DOC:
 ===numberp===
- (numberp VALUE)
+ (numberp VALUE...)
 
 */
 //#AFUNC       numberp ml_numberp
 //#WIKIFUNC    numberp
 MNode*  ml_numberp (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
     MNodePtr  obj;
+    bool  ans = true;
 
-    objType (cell, mlenv, obj);
-    return newMNode_bool (obj () && obj ()->isReal ());
+    if (! arg)
+       return NULL;            // false
+    while (arg && ans) {
+       obj = eval (arg->car (), mlenv);
+       ans &= (obj () && obj ()->isReal ());
+       nextNode (arg);
+    }
+    return newMNode_bool (ans);
 }
 
 /*DOC: