removed to-sexp function.

setarray function, dump-to-sexp function.
bug fix.

diff --git a/lib/expr.cc b/lib/expr.cc
index a195aeb..7950caa 100644 (file)
--- a/lib/expr.cc
+++ b/lib/expr.cc
@@ -114,23 +114,6 @@ ustring  eval_str (MNode* cell, MlEnv* mlenv) {
 
     p = eval (cell, mlenv);
     return to_string (p ());
-#if 0
-    if (p ()) {
-       switch (p ()->type) {
-       case MNode::MC_NIL:
-       case MNode::MC_STR:
-       case MNode::MC_SYM:
-       case MNode::MC_DOUBLE:
-           return p ()->to_string ();
-       case MNode::MC_CONS:
-           return p ()->to_string (false, true);
-       default:
-           throw (p ()->dump_string () + uErrorBadType);
-       }
-    } else {
-       return uEmpty;
-    }
-#endif
 }
 
 ustring  eval_text1 (MNode* cell, MlEnv* mlenv) {
@@ -143,19 +126,6 @@ ustring  eval_asciiword (MNode* cell, MlEnv* mlenv) {
     return omitNonAsciiWord (ans);
 }
 
-#if 0
-ustring*  eval_str_new (MNode* cell, MlEnv* mlenv) {
-    MNodePtr  p;
-//    ustring*  ans = new ustring;
-
-    p = eval (cell, mlenv);
-    if (p ())
-       return new ustring (p ()->to_string ());
-    else
-       return new ustring;
-}
-#endif
-
 bool  eval_bool (MNode* cell, MlEnv* mlenv) {
     MNodePtr  p;
 

diff --git a/lib/ml.cc b/lib/ml.cc
index 47de957..b7695ae 100644 (file)
--- a/lib/ml.cc
+++ b/lib/ml.cc
@@ -105,34 +105,42 @@ ustring  MNode::to_string (bool c, bool listdump) {
     case MNode::MC_CONS:
        {
            ustring  ans;
-           if (! c)
-               ans.append (CharConst ("("));
-           if (cons.car)
-               ans.append (cons.car->to_string (false, true));
-           else
-               ans.append (uNil);
-           if (cons.cdr) {
-               switch (cons.cdr->type) {
-               case MC_NIL:
-                   ans.append (CharConst (")"));
-                   break;
-               case MC_CONS:
-                   ans.append (uSPC);
-                   ans.append (cons.cdr->to_string (true, true));
-                   break;
-               default:
-                   ans.append (CharConst (" . "));
-                   ans.append (cons.cdr->to_string (true, true));
-                   ans.append (CharConst (")"));
-               }               
+           if (! c && cons.car && cons.car->type == MC_SYM && cons.car->str->compare ("quote") == 0 && cons.cdr && cons.cdr->type == MC_CONS) {
+               ans.append (CharConst ("'"));
+               if (! cons.cdr->cons.car)
+                   ans.append (uNil2);
+               else
+                   ans.append (cons.cdr->cons.car->to_string (false, true));
            } else {
-               ans.append (CharConst (")"));
+               if (! c)
+                   ans.append (CharConst ("("));
+               if (cons.car)
+                   ans.append (cons.car->to_string (false, true));
+               else
+                   ans.append (uNil2);
+               if (cons.cdr) {
+                   switch (cons.cdr->type) {
+                   case MC_NIL:
+                       ans.append (CharConst (")"));
+                       break;
+                   case MC_CONS:
+                       ans.append (uSPC);
+                       ans.append (cons.cdr->to_string (true, true));
+                       break;
+                   default:
+                       ans.append (CharConst (" . "));
+                       ans.append (cons.cdr->to_string (true, true));
+                       ans.append (CharConst (")"));
+                   }           
+               } else {
+                   ans.append (CharConst (")"));
+               }
            }
            return ans;
        }
     case MNode::MC_STR:
        if (listdump) {
-           return ustring (CharConst ("\"")).append (slashEncode (*str)).append (CharConst ("\""));
+           return uQ2 + slashEncode (*str) + uQ2;
        } else {
            return ustring (*str);
 //     return *str;
@@ -157,19 +165,22 @@ void  MNode::dump (std::ostream& o, bool c) {
        o << logText (*sym);
        break;
     case MC_STR:
-       o << "\"" << logText (*str) << "\"";
+       o << uQ2 << logText (*str) << uQ2;
        break;
     case MC_CONS:
-       if (! c && car () && car ()->type == MC_SYM && car ()->str->compare ("quote") == 0 && cdr () && cdr ()->type == MC_CONS && cdr ()->car ()) {
+       if (! c && car () && car ()->type == MC_SYM && car ()->str->compare ("quote") == 0 && cdr () && cdr ()->type == MC_CONS) {
            o << "'";
-           cdr ()->car ()->dump (o);
+           if (! cdr ()->car ())
+               o << uNil2;
+           else
+               cdr ()->car ()->dump (o);
        } else {
            if (! c)
                o << "(";
            if (car ())
                car ()->dump (o);
            else
-               o << uNil;
+               o << uNil2;
            if (cdr ()) {
                switch (cdr ()->type) {
                case MC_NIL:
@@ -202,23 +213,22 @@ ustring  MNode::dump_string (bool c) {
     case MC_NIL:
 //     return uNil;
        return uNil2;
-    case MC_SYM:
-       return logText (*sym);
-    case MC_STR:
-       return ustring (CharConst ("\"")) + logText (*str) + "\"";
     case MC_CONS:
        {
            ustring  ans;
-           if (! c && car () && car ()->type == MC_SYM && car ()->str->compare ("quote") == 0 && cdr () && cdr ()->type == MC_CONS && cdr ()->car ()) {
+           if (! c && car () && car ()->type == MC_SYM && car ()->str->compare ("quote") == 0 && cdr () && cdr ()->type == MC_CONS) {
                ans.append (CharConst ("'"));
-               ans.append (cdr ()->car ()->dump_string ());
+               if (! cdr ()->car ())
+                   ans.append (uNil2);
+               else
+                   ans.append (cdr ()->car ()->dump_string ());
            } else {
                if (! c)
                    ans.append (CharConst ("("));
                if (car ())
                    ans.append (car ()->dump_string ());
                else
-                   ans.append (uNil);
+                   ans.append (uNil2);
                if (cdr ()) {
                    switch (cdr ()->type) {
                    case MC_NIL:
@@ -239,6 +249,10 @@ ustring  MNode::dump_string (bool c) {
            }
            return ans;
        }
+    case MC_STR:
+       return uQ2 + logText (*str) + uQ2;
+    case MC_SYM:
+       return logText (*sym);
     case MC_DOUBLE:
        return to_ustring (real);
     default:

diff --git a/lib/mlenv.cc b/lib/mlenv.cc
index d9c8dbc..c4990eb 100644 (file)
--- a/lib/mlenv.cc
+++ b/lib/mlenv.cc
@@ -280,8 +280,6 @@ void  MlEnv::setAry (const ustring& name, MNode* list) {
                    nextNode (list);
                }
            } else {
-//             n ++;
-//             setLocalAry (pool, name, n, list);
                throw (ustring (CharConst ("setting a scalar value to an array.")));
            }
            setLocalArySize (pool, name, n);
@@ -294,8 +292,6 @@ void  MlEnv::setAry (const ustring& name, MNode* list) {
                    nextNode (list);
                }
            } else {
-//             n ++;
-//             setGlobalAry (name, n, list);
                throw (ustring (CharConst ("setting a scalar value to an array.")));
            }
            setGlobalArySize (name, n);

diff --git a/lib/util_const.cc b/lib/util_const.cc
index 5eab9db..9ba87b4 100644 (file)
--- a/lib/util_const.cc
+++ b/lib/util_const.cc
@@ -22,6 +22,7 @@ ustring  uErrorNotFound (CharConst (": not found."));
 ustring  uErrorMissingDatastore (CharConst ("missing datastore parameter."));
 ustring  uErrorBadParamDef (CharConst (": bad parameter definition."));
 ustring  uErrorRegexp (CharConst ("regular expression error."));
+const char*  uErrorNil = "nil data.";
 const char*  uErrorBadType = ": bad type.";
 const char*  uErrorBadCmd = ": bad command.";
 const char*  uErrorCantOpen = ": can't open.";

diff --git a/lib/util_const.h b/lib/util_const.h
index 5554ebd..c4d4e29 100644 (file)
--- a/lib/util_const.h
+++ b/lib/util_const.h
@@ -28,6 +28,7 @@ extern ustring  uErrorMissingDatastore;
 extern ustring  uErrorBadParamDef;
 extern ustring  uErrorRegexp;
 
+extern const char*  uErrorNil;
 extern const char*  uErrorBadType;
 extern const char*  uErrorBadCmd;
 extern const char*  uErrorCantOpen;

diff --git a/modules/ml-encode.cc b/modules/ml-encode.cc
index e46213a..065c135 100644 (file)
--- a/modules/ml-encode.cc
+++ b/modules/ml-encode.cc
@@ -169,7 +169,7 @@ MNode*  ml_percent_encode (MNode* cell, MlEnv* mlenv) {
 
 /*DOC:
 ===percent-decode===
- (percent-encode STRING...) -> STRING
+ (percent-decode STRING...) -> STRING
 
 */
 //#AFUNC       percent-decode  ml_percent_decode

diff --git a/modules/ml-string.cc b/modules/ml-string.cc
index d508adb..6ed8741 100644 (file)
--- a/modules/ml-string.cc
+++ b/modules/ml-string.cc
@@ -785,13 +785,47 @@ MNode*  ml_to_string (MNode* cell, MlEnv* mlenv) {
 }
 
 /*DOC:
-===to-sexp===
- (to-sexp STRING) -> OBJECT
+===dump-to-sexp===
+ (dump-to-sexp OBJECT...) -> STRING
 
 */
-//#AFUNC       to-sexp ml_to_sexp
-//#WIKIFUNC    to-sexp
-MNode*  ml_to_sexp (MNode* cell, MlEnv* mlenv) {
+//#AFUNC       dump-to-sexp    ml_dump_to_sexp
+//#WIKIFUNC    dump-to-sexp
+MNode*  ml_dump_to_sexp (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  e;
+    ustring  text;
+
+    while (arg) {
+//     text = eval_str (arg->car (), mlenv);
+       e = eval (arg->car (), mlenv);
+       nextNode (arg);
+       if (text.length () > 0)
+           text.append (CharConst (" "));
+       if (isNil (e ())) {
+           text.append (uNil2);
+       } else if (e ()->isStr ()) {
+           text.append (uQ2).append (slashEncode (*e ()->str)).append (uQ2);
+       } else {
+           text.append (e ()->to_string ());
+       }
+    }
+    return newMNode_str (new ustring (text));
+}
+
+/*DOC:
+//===to-sexp===
+// (to-sexp STRING) -> OBJECT
+===read-sexp===
+ (read-sexp STRING) -> OBJECT
+
+*/
+//  //#AFUNC   to-sexp ml_to_sexp
+//  //#WIKIFUNC        to-sexp
+//#AFUNC       read-sexp       ml_read_sexp
+//#WIKIFUNC    read-sexp
+//MNode*  ml_to_sexp (MNode* cell, MlEnv* mlenv) {
+MNode*  ml_read_sexp (MNode* cell, MlEnv* mlenv) {
     MNode*  arg = cell->cdr ();
     ustring  text;
     MotorSexp ml (NULL);

diff --git a/modules/ml-string.h b/modules/ml-string.h
index eed6fa6..fa789d4 100644 (file)
--- a/modules/ml-string.h
+++ b/modules/ml-string.h
@@ -27,7 +27,9 @@ MNode*  ml_date_format (MNode* cell, MlEnv* mlenv);
 MNode*  ml_gmdate_format (MNode* cell, MlEnv* mlenv);
 MNode*  ml_random_key (MNode* cell, MlEnv* mlenv);
 MNode*  ml_to_string (MNode* cell, MlEnv* mlenv);
-MNode*  ml_to_sexp (MNode* cell, MlEnv* mlenv);
+MNode*  ml_dump_to_sexp (MNode* cell, MlEnv* mlenv);
+//MNode*  ml_to_sexp (MNode* cell, MlEnv* mlenv);
+MNode*  ml_read_sexp (MNode* cell, MlEnv* mlenv);
 MNode*  ml_is_ascii63 (MNode* cell, MlEnv* mlenv);
 MNode*  ml_sort_string (MNode* cell, MlEnv* mlenv);
 MNode*  ml_to_upper (MNode* cell, MlEnv* mlenv);

diff --git a/modules/ml-struct.cc b/modules/ml-struct.cc
index 26af869..c630bbb 100644 (file)
--- a/modules/ml-struct.cc
+++ b/modules/ml-struct.cc
@@ -854,6 +854,8 @@ MNode*  ml_replca (MNode* cell, MlEnv* mlenv) {
     if (arg)
        throw (uErrorWrongNumber);
 
+    if (! c ())
+       throw (ustring (CharConst ("nil data.")));
     if (! c ()->isCons ())
        throw (c ()->dump_string () + uErrorBadType);
     c ()->unset_car ();
@@ -882,6 +884,8 @@ MNode*  ml_replcd (MNode* cell, MlEnv* mlenv) {
     if (arg)
        throw (uErrorWrongNumber);
 
+    if (! c ())
+       throw (ustring (CharConst ("nil data.")));
     if (! c ()->isCons ())
        throw (c ()->dump_string () + uErrorBadType);
     c ()->unset_cdr ();

diff --git a/modules/ml-variable.cc b/modules/ml-variable.cc
index a969508..ca355e6 100644 (file)
--- a/modules/ml-variable.cc
+++ b/modules/ml-variable.cc
@@ -85,6 +85,59 @@ MNode*  ml_setvar (MNode* cell, MlEnv* mlenv) {
 }
 
 /*DOC:
+===setarray===
+ (setarray ARRAY_LIST LIST_OF_LIST [ARRAY_LIST LIST_OF_LIST]...) -> LAST_VALUE
+
+*/
+//#AFUNC       setarray        ml_setarray
+//#WIKIFUNC    setarray
+MNode*  ml_setarray (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  ans;
+
+    while (arg) {
+       MNodePtr  v1;
+       v1 = eval (arg->car (), mlenv);
+       nextNode (arg);
+       if (arg) {
+           ans = eval (arg->car (), mlenv);
+           nextNode (arg);
+       } else {
+           ans = NULL;
+       }
+       MNode*  a1 = v1 ();
+       MNode*  a2 = ans ();
+       if (a1 && a1->isCons ()) {
+           std::vector<ustring>  vars;
+           std::vector<ustring>::const_iterator  v;
+           size_t  n = 0;
+           while (a1 && a1->isCons ()) {
+               vars.push_back (to_string (a1->car ()));
+               nextNode (a1);
+           }
+           while (a2 && a2->isCons ()) {
+               MNode*  a3 = a2->car ();
+               n ++;
+               for (v = vars.begin (); v < vars.end (); v ++) {
+                   if (a3 && a3->isCons ()) {
+                       mlenv->setAry (*v, n, a3->car ());
+                   } else {
+                       mlenv->setAry (*v, n, NULL);
+                   }
+                   nextNode (a3);
+               }
+               nextNode (a2);
+           }
+           for (v = vars.begin (); v < vars.end (); v ++) {
+               mlenv->setArySize (*v, n);
+           }
+       } else {
+           throw (ustring (CharConst ("wrong type of parameter")));
+       }
+    }
+}
+
+/*DOC:
 ===setevar===
  (setevar VARIABLE ...) -> VARIABLE
 

diff --git a/modules/ml-variable.h b/modules/ml-variable.h
index 81309fd..1e833bc 100644 (file)
--- a/modules/ml-variable.h
+++ b/modules/ml-variable.h
@@ -5,6 +5,7 @@
 class  MlEnv;
 
 MNode*  ml_setvar (MNode* cell, MlEnv* mlenv);
+MNode*  ml_setarray (MNode* cell, MlEnv* mlenv);
 MNode*  ml_setevar (MNode* cell, MlEnv* mlenv);
 MNode*  ml_let (MNode* cell, MlEnv* mlenv);
 MNode*  ml_getvar (MNode* cell, MlEnv* mlenv);