add vector functions.

bug fix.

diff --git a/ext/ml-json.cc b/ext/ml-json.cc
index eb503ab..f064f73 100644 (file)
--- a/ext/ml-json.cc
+++ b/ext/ml-json.cc
@@ -112,7 +112,7 @@ static MNode*  picoj2texp (const picojson::value& v) {
 
 /*DOC:
 ===json-read===
- (json-read TEXT [#array-is-list | :array-is-cons SYMBOL |#function-symbol]) -> LIST
+ (json-read TEXT [#array-is-list | :array-is-cons SYMBOL | #function-symbol | #texp]) -> LIST
 *list mode
  scalar_value → Atom
  array → List

diff --git a/lib/ml.cc b/lib/ml.cc
index de1604a..6f5a3a6 100644 (file)
--- a/lib/ml.cc
+++ b/lib/ml.cc
@@ -220,19 +220,52 @@ void  MNode::vectorPut (size_t pos, MNode* e) {
     vector->put (pos, e);
 }
 
+MNode*  MNode::vectorDel (size_t pos) {
+    if (type != MC_VECTOR)
+       throw (uErrorWrongType );
+    MNodePtr  ans;
+    size_t  n = vector->size ();
+    size_t  to = pos + 1;
+    ans = vector->get (pos);
+    if (pos < n) {
+       for (; to < n; ++ pos, ++ to) {
+           vector->put (pos, vector->get (to));
+       }
+       vector->resize (pos);
+    }
+    return ans.release ();
+}
+
 MNode*  MNode::vectorDel (size_t from, size_t to) {
     if (type != MC_VECTOR)
        throw (uErrorWrongType );
-    MNode*  ans = vector->get (from);
+    MNodePtr  ans;
     size_t  n = vector->size ();
+    size_t  pos;
     ++ to;
-    if (from < to) {
+    ans = newMNode_vector ();
+    for (pos = from; pos < to; ++ pos) {
+       ans ()->vectorPush (vector->get (pos));
+    }
+    if (from < n && from < to) {
        for (; to < n; ++ from, ++ to) {
            vector->put (from, vector->get (to));
        }
        vector->resize (from);
     }
-    return ans;
+    return ans.release ();
+}
+
+void  MNode::vectorUnshift (MNode* e) {
+    if (type != MC_VECTOR)
+       throw (uErrorWrongType );
+    vector->unshift (e);
+}
+
+MNode*  MNode::vectorShift () {
+    if (type != MC_VECTOR)
+       throw (uErrorWrongType );
+    return vector->shift ();
 }
 
 void  MNode::vectorPush (MNode* e) {
@@ -282,9 +315,47 @@ double  MNode::to_double () {
     case MNode::MC_TABLE:
        return 0.;
     case MNode::MC_STR:
-       return atof (str->c_str ());
+       return boost::lexical_cast<double> (*str);
+    case MNode::MC_SYM:
+       return boost::lexical_cast<double> (*sym);
+    case MNode::MC_DOUBLE:
+       return real;
+    default:
+       assert (0);
+    }
+}
+
+int  MNode::to_int () {
+    switch (type) {
+    case MNode::MC_NIL:
+       return 0;
+    case MNode::MC_CONS:
+    case MNode::MC_VECTOR:
+    case MNode::MC_TABLE:
+       return 0;
+    case MNode::MC_STR:
+       return boost::lexical_cast<int> (*str);
+    case MNode::MC_SYM:
+       return boost::lexical_cast<int> (*sym);
+    case MNode::MC_DOUBLE:
+       return real;
+    default:
+       assert (0);
+    }
+}
+
+int64_t  MNode::to_int64 () {
+    switch (type) {
+    case MNode::MC_NIL:
+       return 0;
+    case MNode::MC_CONS:
+    case MNode::MC_VECTOR:
+    case MNode::MC_TABLE:
+       return 0;
+    case MNode::MC_STR:
+       return boost::lexical_cast<int64_t> (*str);
     case MNode::MC_SYM:
-       return atof (sym->c_str ());
+       return boost::lexical_cast<int64_t> (*sym);
     case MNode::MC_DOUBLE:
        return real;
     default:

diff --git a/lib/ml.h b/lib/ml.h
index 8fe7480..912d280 100644 (file)
--- a/lib/ml.h
+++ b/lib/ml.h
@@ -158,7 +158,10 @@ class  MNode {
     MNode*  vectorGet (size_t pos);
     size_t  vectorSize ();
     void  vectorPut (size_t pos, MNode* e);
+    MNode*  vectorDel (size_t pos);
     MNode*  vectorDel (size_t from, size_t to);
+    void  vectorUnshift (MNode* e);
+    MNode*  vectorShift ();
     void  vectorPush (MNode* e);
     MNode*  vectorPop ();
     void  vectorResize (size_t pos);
@@ -166,12 +169,8 @@ class  MNode {
     void  tablePut (const ustring& name, MNode* e);
     MNode*  tableDel (const ustring& name);
     double  to_double ();
-    int  to_int () {
-       return (int)to_double ();
-    };
-    int64_t  to_int64 () {
-       return (int64_t)to_double ();
-    };
+    int  to_int ();
+    int64_t  to_int64 ();
     bool  to_bool ();
     ustring  sym_to_string ();
     ustring  cons_to_texp (bool fcdr = false);

diff --git a/lib/motorenv.cc b/lib/motorenv.cc
index 0831b18..ea9feba 100644 (file)
--- a/lib/motorenv.cc
+++ b/lib/motorenv.cc
@@ -450,10 +450,12 @@ void  MotorEnv::doML (const ustring& file) {
        if (ml.top.isCons ()) {
            try {
                progn_ex (&ml.top, mlenv);
-           }
-           catch (ustring& msg) {
+           } catch (ustring& msg) {
                logMessage (msg);
                mlenv->currentCell = NULL;
+           } catch (boost::bad_lexical_cast tmsg) {
+               logMessage (uErrorBadValueN);
+               mlenv->currentCell = NULL;
            }
        }
     } else {
@@ -507,6 +509,9 @@ void  MotorEnv::doMotorText (const ustring& text, const ustring& type, MotorOutp
     } catch (ustring& msg) {
        logMessage (msg);
        mlenv->currentCell = NULL;
+    } catch (boost::bad_lexical_cast tmsg) {
+       logMessage (uErrorBadValueN);
+       mlenv->currentCell = NULL;
     }
 }
 
@@ -522,6 +527,9 @@ void  MotorEnv::doMotorFile (const ustring& file, bool skipHead, const ustring&
     } catch (ustring& msg) {
        logMessage (msg);
        mlenv->currentCell = NULL;
+    } catch (boost::bad_lexical_cast tmsg) {
+       logMessage (uErrorBadValueN);
+       mlenv->currentCell = NULL;
     }
 }
 

diff --git a/lib/motorvar.cc b/lib/motorvar.cc
index 12b2700..00b18e8 100644 (file)
--- a/lib/motorvar.cc
+++ b/lib/motorvar.cc
@@ -88,3 +88,29 @@ void  MotorVector::put (size_type pos, MNode* val) {
     at (pos) = val;
 }
 
+void  MotorVector::unshift (MNode* val) {
+    size_t  n = size ();
+    if (n > 0) {
+       push (get (n - 1));
+       for (size_t i = n - 1; i > 0; -- i) {
+           put (i, get (i - 1));
+       }
+       put (0, val);
+    } else {
+       push (val);
+    }
+}
+
+MNode*  MotorVector::shift () {
+    size_t  n = size ();
+    if (n > 0) {
+       MNode*  ans = get (0);
+       for (size_t i = 1; i < n; ++ i) {
+           put (i - 1, get (i));
+       }
+       pop ();
+       return ans;
+    } else {
+       return NULL;
+    }
+}

diff --git a/lib/motorvar.h b/lib/motorvar.h
index ef3f8bb..dd603c0 100644 (file)
--- a/lib/motorvar.h
+++ b/lib/motorvar.h
@@ -43,8 +43,10 @@ class  MotorVector: public boost::ptr_vector<MNodePtr> {
 
     virtual void  push (MNode* val);
     virtual MNode*  pop ();
-    virtual MNode*  get (size_type pos);       // 1-base
+    virtual MNode*  get (size_type pos);       // 0-base
     virtual void  put (size_type pos, MNode* val);
+    virtual void  unshift (MNode* val);
+    virtual MNode*  shift ();
 };
 
 #endif /* MOTORVAR_H */

diff --git a/lib/util_const.cc b/lib/util_const.cc
index 353a88c..6f0710c 100644 (file)
--- a/lib/util_const.cc
+++ b/lib/util_const.cc
@@ -17,6 +17,7 @@ ustring  uErrorNoStorage (CharConst ("no named store directory."));
 ustring  uErrorInclNest (CharConst ("deeply nested."));
 ustring  uErrorBadName (CharConst (": bad name."));
 ustring  uErrorBadParam (CharConst (": bad parameter."));
+ustring  uErrorBadValueN (CharConst ("bad value."));
 ustring  uErrorBadValue (CharConst (": bad value."));
 ustring  uErrorNotFound (CharConst (": not found."));
 ustring  uErrorMissingDatastore (CharConst ("missing datastore parameter."));

diff --git a/lib/util_const.h b/lib/util_const.h
index 2d79912..99991f0 100644 (file)
--- a/lib/util_const.h
+++ b/lib/util_const.h
@@ -22,6 +22,7 @@ extern ustring  uErrorNoStorage;
 extern ustring  uErrorInclNest;
 extern ustring  uErrorBadName;
 extern ustring  uErrorBadParam;
+extern ustring  uErrorBadValueN;
 extern ustring  uErrorBadValue;
 extern ustring  uErrorNotFound;
 extern ustring  uErrorMissingDatastore;

diff --git a/ml/main.cc b/ml/main.cc
index 81f536c..6dc4056 100644 (file)
--- a/ml/main.cc
+++ b/ml/main.cc
@@ -87,11 +87,11 @@ int  main (int argc, char** argv) {
        env.doMotor ();
     }
     catch (ustring& msg) {
-       std::cerr << msg << "\n";
+       std::cerr << msg << uLF;
        goto Ex1;
     }
-    catch (boost::bad_lexical_cast msg) {
-       std::cerr << "bad values\n";
+    catch (boost::bad_lexical_cast tmsg) {
+       std::cerr << uErrorBadValueN << uLF;
        goto Ex1;
     }
 

diff --git a/modules/ml-texp.cc b/modules/ml-texp.cc
index 85848fc..ca4a4b1 100644 (file)
--- a/modules/ml-texp.cc
+++ b/modules/ml-texp.cc
@@ -154,27 +154,81 @@ MNode*  ml_vector_put (MNode* cell, MlEnv* mlenv) {
 MNode*  ml_vector_del (MNode* cell, MlEnv* mlenv) {
     MNode*  arg = cell->cdr ();
     MNodePtr  vec;
-    int  from, to;
+    MNodePtr  fromobj, toobj;
 
     if (! arg)
        throw (uErrorWrongNumber);
     vec = eval (arg->car (), mlenv);
     nextNodeNonNil (arg);
-    from = eval_int (arg->car (), mlenv);
+    fromobj = eval (arg->car (), mlenv);
     nextNode (arg);
     if (arg) {
-       to = eval_int (arg->car (), mlenv);
+       toobj = eval (arg->car (), mlenv);
        nextNode (arg);
+    }
+    if (arg)
+       throw (uErrorWrongNumber);
+
+    if (! isVector (vec ()))
+       throw (uErrorWrongType);
+
+    if (isNil (toobj ())) {
+       return vec ()->vectorDel (to_int (fromobj ()));
     } else {
-       to = from;
+       return vec ()->vectorDel (to_int (fromobj ()), to_int (toobj ()));
     }
+}
+
+/*DOC:
+===vector-unshift===
+ (vector-unshift VECTOR VALUE) -> VALUE
+
+*/
+//#AFUNC       vector-unshift  ml_vector_unshift
+//#WIKIFUNC    vector-unshift
+MNode*  ml_vector_unshift (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  vec;
+    MNodePtr  e;
+
+    if (! arg)
+       throw (uErrorWrongNumber);
+    vec = eval (arg->car (), mlenv);
+    nextNodeNonNil (arg);
+    e = eval (arg->car (), mlenv);
+    nextNode (arg);
+    if (arg)
+       throw (uErrorWrongNumber);
+
+    if (! isVector (vec ()))
+       throw (uErrorWrongType);
+
+    vec ()->vectorUnshift (e ());
+    return e.release ();
+}
+
+/*DOC:
+===vector-shift===
+ (vector-shift VECTOR) -> VALUE
+
+*/
+//#AFUNC       vector-shift    ml_vector_shift
+//#WIKIFUNC    vector-shift
+MNode*  ml_vector_shift (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  vec;
+
+    if (! arg)
+       throw (uErrorWrongNumber);
+    vec = eval (arg->car (), mlenv);
+    nextNode (arg);
     if (arg)
        throw (uErrorWrongNumber);
 
     if (! isVector (vec ()))
        throw (uErrorWrongType);
 
-    return vec ()->vectorDel (from, to);
+    return vec ()->vectorShift ();
 }
 
 /*DOC:

diff --git a/modules/ml-texp.h b/modules/ml-texp.h
index 1856e5e..49768ea 100644 (file)
--- a/modules/ml-texp.h
+++ b/modules/ml-texp.h
@@ -83,6 +83,8 @@ MNode*  ml_vector_back (MNode* cell, MlEnv* mlenv);
 MNode*  ml_vector_size (MNode* cell, MlEnv* mlenv);
 MNode*  ml_vector_put (MNode* cell, MlEnv* mlenv);
 MNode*  ml_vector_del (MNode* cell, MlEnv* mlenv);
+MNode*  ml_vector_unshift (MNode* cell, MlEnv* mlenv);
+MNode*  ml_vector_shift (MNode* cell, MlEnv* mlenv);
 MNode*  ml_vector_push (MNode* cell, MlEnv* mlenv);
 MNode*  ml_vector_pop (MNode* cell, MlEnv* mlenv);
 MNode*  ml_vector_append (MNode* cell, MlEnv* mlenv);