save point.

diff --git a/Makefile.src b/Makefile.src
index b941776..159e53d 100644 (file)
--- a/Makefile.src
+++ b/Makefile.src
@@ -1,3 +1,4 @@
+MSRCS += ml-texp.cc
 MSRCS += ml-imagesize.cc
 MSRCS += ml-security.cc
 MLDADD += -lmd

diff --git a/lib/expr.cc b/lib/expr.cc
index a98a2d8..208baef 100644 (file)
--- a/lib/expr.cc
+++ b/lib/expr.cc
@@ -91,16 +91,34 @@ MNode*  eval (MNode* cell, MlEnv* mlenv) {
        return cell;
     case MNode::MC_VECTOR:
 //     return vectorEval (cell, mlenv);
-       return cell;
+//     return cell;
+       return vectorDup (cell);
     case MNode::MC_TABLE:
 //     return tableEval (cell, mlenv);
-       return cell;
+//     return cell;
+       return tableDup (cell);
     default:
        assert (0);
     }
     return NULL;                       // not reached
 }
 
+MNode*  vectorDup (MNode* c) {
+    MNodePtr  ans;
+    MNode*  x;
+    MotorVector::iterator  b, e;
+
+    assert (c && c->isVector ());
+    x = newMNode_vector ();
+    ans = x;
+    b = c->vector->begin ();
+    e = c->vector->end ();
+    for (; b < e; ++ b) {
+       x->vectorPush ((*b) ());
+    }
+    return ans.release ();
+}
+
 MNode*  vectorEval (MNode* c, MlEnv* mlenv) {
     MNodePtr  ans;
     MNode*  x;
@@ -120,6 +138,23 @@ MNode*  vectorEval (MNode* c, MlEnv* mlenv) {
     return ans.release ();
 }
 
+MNode*  tableDup (MNode* c) {
+    MNodePtr  ans;
+    MNode*  x;
+    MotorVar::iterator  b, e;
+
+    assert (c && c->isTable ());
+    x = newMNode_table ();
+    ans = x;
+    b = c->table->begin ();
+    e = c->table->end ();
+    for (; b != e; ++ b) {
+       x->tablePut ((*b).first, (*b).second ());
+    }
+
+    return ans.release ();
+}
+
 MNode*  tableEval (MNode* c, MlEnv* mlenv) {
     MNodePtr  ans;
     MNode*  x;

diff --git a/lib/expr.h b/lib/expr.h
index 4864dc4..a0aa81c 100644 (file)
--- a/lib/expr.h
+++ b/lib/expr.h
@@ -15,7 +15,9 @@ typedef struct {
 }  paramList;
 
 MNode*  eval (MNode* ptr, MlEnv* mlenv);
+MNode*  vectorDup (MNode* c);
 MNode*  vectorEval (MNode* c, MlEnv* mlenv);
+MNode*  tableDup (MNode* c);
 MNode*  tableEval (MNode* c, MlEnv* mlenv);
 double  eval_double (MNode* ptr, MlEnv* mlenv);
 int  eval_int (MNode* ptr, MlEnv* mlenv);

diff --git a/lib/ml.cc b/lib/ml.cc
index b5ba06e..9d566a4 100644 (file)
--- a/lib/ml.cc
+++ b/lib/ml.cc
@@ -72,6 +72,11 @@ MNode*  MNode::vectorGet (size_t pos) {
     return vector->get (pos);
 }
 
+size_t  MNode::vectorSize () {
+    assert (type == MC_VECTOR);
+    return vector->size ();
+}
+
 void  MNode::vectorPut (size_t pos, MNode* e) {
     assert (type == MC_VECTOR);
     vector->put (pos, e);

diff --git a/lib/ml.h b/lib/ml.h
index e9783cd..faacabd 100644 (file)
--- a/lib/ml.h
+++ b/lib/ml.h
@@ -155,6 +155,7 @@ class  MNode {
        return cons.cdr;
     };
     MNode*  vectorGet (size_t pos);
+    size_t  vectorSize ();
     void  vectorPut (size_t pos, MNode* e);
     void  vectorPush (MNode* e);
     MNode*  vectorPop ();

diff --git a/lib/motorvar.cc b/lib/motorvar.cc
index 9839272..118df88 100644 (file)
--- a/lib/motorvar.cc
+++ b/lib/motorvar.cc
@@ -83,9 +83,10 @@ void  MotorVector::put (size_type pos, MNode* val) {
     if (pos < 0) {
        return;
     } else if (0 <= pos && pos < size ()) {
-       at (pos) = val;
     } else {
-       throw (ustring ("index out of range."));
+       while (pos >= size ())
+           push (NULL);
     }
+    at (pos) = val;
 }
 

diff --git a/modules/ml-string.cc b/modules/ml-string.cc
index 3ed285e..5de20d7 100644 (file)
--- a/modules/ml-string.cc
+++ b/modules/ml-string.cc
@@ -593,7 +593,7 @@ MNode*  ml_split (MNode* cell, MlEnv* mlenv) {
 
 /*DOC:
 ===string-join===
- (string-join TEXT [STRING | ARRAY | LIST]...) -> STRING
+ (string-join TEXT [STRING | ARRAY | LIST | VECTOR]...) -> STRING
 
 */
 //#AFUNC       string-join     ml_string_join
@@ -642,6 +642,16 @@ MNode*  ml_string_join (MNode* cell, MlEnv* mlenv) {
                    if (! isNil (a->car ()))
                        ans.append (a->car ()->to_string ());
                }
+           } else if (val ()->isVector ()) {
+               size_t  n = val ()->vectorSize ();
+               size_t  i;
+               for (i = 0; i < n; ++ i) {
+                   if (i > 0)
+                       ans.append (sep);
+                   MNode*  a = val ()->vectorGet (i);
+                   if (! isNil (a))
+                       ans.append (a->to_string ());
+               }
            } else {
                var = val ()->to_string ();
                if (c == 0)

diff --git a/modules/ml-texp.cc b/modules/ml-texp.cc
new file mode 100644 (file)
index 0000000..201bf5c
--- /dev/null
+++ b/modules/ml-texp.cc
@@ -0,0 +1,280 @@
+#include "ml-texp.h"
+#include "ml.h"
+#include "mlenv.h"
+#include "motorenv.h"
+#include "util_const.h"
+#include "util_check.h"
+#include "ustring.h"
+#include "expr.h"
+#include <exception>
+
+/*DOC:
+==t-expression accessing==
+
+*/
+/*DOC:
+===vector===
+ (vector OBJ ...) -> VECTOR
+
+*/
+//#AFUNC       vector  ml_vector
+//#WIKIFUNC    vector
+MNode*  ml_vector (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    int  n;
+    MNodePtr  ans;
+
+    ans = newMNode_vector ();
+    while (arg) {
+       ans ()->vectorPush (eval (arg->car (), mlenv));
+       nextNode (arg);
+    }
+    return ans.release ();
+}
+
+/*DOC:
+===vector-get===
+ (vector-get VECTOR N) -> VALUE
+
+*/
+//#AFUNC       vector-get      ml_vector_get
+//#WIKIFUNC    vector-get
+MNode*  ml_vector_get (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  vec;
+    int  n;
+
+    if (! arg)
+       throw (uErrorWrongNumber);
+    vec = eval (arg->car (), mlenv);
+    nextNodeNonNil (arg);
+    n = eval_int (arg->car (), mlenv);
+    nextNode (arg);
+    if (arg)
+       throw (uErrorWrongNumber);
+
+    if (! vec () || ! vec ()->isVector ()) {
+       throw (uErrorWrongType);
+    }
+    return vec ()->vectorGet (n);
+}
+
+/*DOC:
+===vector-size===
+ (vector-size VECTOR) -> INTEGER
+
+*/
+//#AFUNC       vector-size     ml_vector_size
+//#WIKIFUNC    vector-size
+MNode*  ml_vector_size (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 (! vec () || ! vec ()->isVector ()) {
+       throw (uErrorWrongType);
+    }
+    return newMNode_num (vec ()->vectorSize ());
+}
+
+/*DOC:
+===vector-put===
+ (vector-put VECTOR N VALUE) -> VALUE
+
+*/
+//#AFUNC       vector-put      ml_vector_put
+//#WIKIFUNC    vector-put
+MNode*  ml_vector_put (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  vec;
+    int  n;
+    MNodePtr  e;
+
+    if (! arg)
+       throw (uErrorWrongNumber);
+    vec = eval (arg->car (), mlenv);
+    nextNodeNonNil (arg);
+    n = eval_int (arg->car (), mlenv);
+    nextNodeNonNil (arg);
+    e = eval (arg->car (), mlenv);
+    nextNode (arg);
+    if (arg)
+       throw (uErrorWrongNumber);
+
+    if (! vec () || ! vec ()->isVector ()) {
+       throw (uErrorWrongType);
+    }
+    vec ()->vectorPut (n, e ());
+    return e.release ();
+}
+
+/*DOC:
+===vector-push===
+ (vector-push VECTOR VALUE) -> VALUE
+
+*/
+//#AFUNC       vector-push     ml_vector_push
+//#WIKIFUNC    vector-push
+MNode*  ml_vector_push (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 (! vec () || ! vec ()->isVector ()) {
+       throw (uErrorWrongType);
+    }
+    vec ()->vectorPush (e ());
+    return e.release ();
+}
+
+/*DOC:
+===vector-pop===
+ (vector-pop VECTOR) -> VALUE
+
+*/
+//#AFUNC       vector-pop      ml_vector_pop
+//#WIKIFUNC    vector-pop
+MNode*  ml_vector_pop (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 (! vec () || ! vec ()->isVector ()) {
+       throw (uErrorWrongType);
+    }
+    return vec ()->vectorPop ();
+}
+
+/*DOC:
+===vector-resize===
+ (vector-resize VECTOR N) -> VECTOR
+
+*/
+//#AFUNC       vector-resize   ml_vector_resize
+//#WIKIFUNC    vector-resize
+MNode*  ml_vector_resize (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  vec;
+    int  n;
+
+    if (! arg)
+       throw (uErrorWrongNumber);
+    vec = eval (arg->car (), mlenv);
+    nextNodeNonNil (arg);
+    n = eval_int (arg->car (), mlenv);
+    nextNode (arg);
+    if (arg)
+       throw (uErrorWrongNumber);
+
+    if (! vec () || ! vec ()->isVector ()) {
+       throw (uErrorWrongType);
+    }
+    vec ()->vectorResize (n);
+    return vec.release ();
+}
+
+/*DOC:
+===table===
+ (table CONS ...) -> TABLE
+
+*/
+//#AFUNC       table   ml_table
+//#WIKIFUNC    table
+MNode*  ml_table (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    int  n;
+    MNodePtr  ans;
+    MNodePtr  v;
+
+    ans = newMNode_table ();
+    while (arg) {
+       v = eval (arg->car (), mlenv);
+       nextNode (arg);
+       if (v () && v ()->isCons ()) {
+           ans ()->tablePut (to_string (v ()->car ()), v ()->cdr ());
+       } else {
+           throw (uErrorWrongType);
+       }
+    }
+    return ans.release ();
+}
+
+/*DOC:
+===table-get===
+ (table-get TABLE NAME) -> VALUE
+
+*/
+//#AFUNC       table-get       ml_table_get
+//#WIKIFUNC    table-get
+MNode*  ml_table_get (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  tbl;
+    ustring  name;
+
+    if (! arg)
+       throw (uErrorWrongNumber);
+    tbl = eval (arg->car (), mlenv);
+    nextNodeNonNil (arg);
+    name = eval_str (arg->car (), mlenv);
+    nextNode (arg);
+    if (arg)
+       throw (uErrorWrongNumber);
+
+    if (! tbl () && ! tbl ()->isTable ()) {
+       throw (uErrorWrongType);
+    }
+    return tbl ()->tableGet (name);
+}
+
+/*DOC:
+===table-put===
+ (table-put TABLE NAME VALUE) -> VALUE
+
+*/
+//#AFUNC       table-put       ml_table_put
+//#WIKIFUNC    table-put
+MNode*  ml_table_put (MNode* cell, MlEnv* mlenv) {
+    MNode*  arg = cell->cdr ();
+    MNodePtr  tbl;
+    ustring  name;
+    MNodePtr  e;
+
+    if (! arg)
+       throw (uErrorWrongNumber);
+    tbl = eval (arg->car (), mlenv);
+    nextNodeNonNil (arg);
+    name = eval_str (arg->car (), mlenv);
+    nextNodeNonNil (arg);
+    e = eval (arg->car (), mlenv);
+    nextNode (arg);
+    if (arg)
+       throw (uErrorWrongNumber);
+
+    if (! tbl () && ! tbl ()->isTable ()) {
+       throw (uErrorWrongType);
+    }
+    tbl ()->tablePut (name, e ());
+    return e.release ();
+}
+

diff --git a/modules/ml-texp.h b/modules/ml-texp.h
new file mode 100644 (file)
index 0000000..8259a0f
--- /dev/null
+++ b/modules/ml-texp.h
@@ -0,0 +1,18 @@
+#ifndef ML_TEXP_H
+#define ML_TEXP_H
+
+#include "ml.h"
+class  MlEnv;
+
+MNode*  ml_vector (MNode* cell, MlEnv* mlenv);
+MNode*  ml_vector_get (MNode* cell, MlEnv* mlenv);
+MNode*  ml_vector_size (MNode* cell, MlEnv* mlenv);
+MNode*  ml_vector_put (MNode* cell, MlEnv* mlenv);
+MNode*  ml_vector_push (MNode* cell, MlEnv* mlenv);
+MNode*  ml_vector_pop (MNode* cell, MlEnv* mlenv);
+MNode*  ml_vector_resize (MNode* cell, MlEnv* mlenv);
+MNode*  ml_table (MNode* cell, MlEnv* mlenv);
+MNode*  ml_table_get (MNode* cell, MlEnv* mlenv);
+MNode*  ml_table_put (MNode* cell, MlEnv* mlenv);
+
+#endif /* ML_TEXP_H */

diff --git a/modules/ml-variable.cc b/modules/ml-variable.cc
index 3b546a8..53352b0 100644 (file)
--- a/modules/ml-variable.cc
+++ b/modules/ml-variable.cc
@@ -239,255 +239,6 @@ MNode*  ml_getvar (MNode* cell, MlEnv* mlenv) {
 }
 
 /*DOC:
-===vector===
- (vector OBJ ...) -> VECTOR
-
-*/
-//#AFUNC       vector  ml_vector
-//#WIKIFUNC    vector
-MNode*  ml_vector (MNode* cell, MlEnv* mlenv) {
-    MNode*  arg = cell->cdr ();
-    int  n;
-    MNodePtr  ans;
-
-    ans = newMNode_vector ();
-    while (arg) {
-       ans ()->vectorPush (eval (arg->car (), mlenv));
-       nextNode (arg);
-    }
-    return ans.release ();
-}
-
-/*DOC:
-===vector-get===
- (vector-get N VECTOR) -> VALUE
-
-*/
-//#AFUNC       vector-get      ml_vector_get
-//#WIKIFUNC    vector-get
-MNode*  ml_vector_get (MNode* cell, MlEnv* mlenv) {
-    MNode*  arg = cell->cdr ();
-    int  n;
-    MNodePtr  v;
-
-    if (! arg)
-       throw (uErrorWrongNumber);
-    n = eval_int (arg->car (), mlenv);
-    nextNode (arg);
-    v = eval (arg->car (), mlenv);
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
-
-    if (v () && v ()->isVector ()) {
-    } else {
-       throw (uErrorWrongType);
-    }
-    return v ()->vectorGet (n);
-}
-
-/*DOC:
-===vector-put===
- (vector-put VALUE N VECTOR) -> VALUE
-
-*/
-//#AFUNC       vector-put      ml_vector_put
-//#WIKIFUNC    vector-put
-MNode*  ml_vector_put (MNode* cell, MlEnv* mlenv) {
-    MNode*  arg = cell->cdr ();
-    MNodePtr  e;
-    int  n;
-    MNodePtr  v;
-
-    if (! arg)
-       throw (uErrorWrongNumber);
-    e = eval (arg->car (), mlenv);
-    nextNode (arg);
-    n = eval_int (arg->car (), mlenv);
-    nextNode (arg);
-    v = eval (arg->car (), mlenv);
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
-
-    if (v () && v ()->isVector ()) {
-    } else {
-       throw (uErrorWrongType);
-    }
-    v ()->vectorPut (n, e ());
-    return e.release ();
-}
-
-/*DOC:
-===vector-push===
- (vector-push VALUE VECTOR) -> VALUE
-
-*/
-//#AFUNC       vector-push     ml_vector_push
-//#WIKIFUNC    vector-push
-MNode*  ml_vector_push (MNode* cell, MlEnv* mlenv) {
-    MNode*  arg = cell->cdr ();
-    MNodePtr  e;
-    MNodePtr  v;
-
-    if (! arg)
-       throw (uErrorWrongNumber);
-    e = eval (arg->car (), mlenv);
-    nextNode (arg);
-    v = eval (arg->car (), mlenv);
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
-
-    if (v () && v ()->isVector ()) {
-    } else {
-       throw (uErrorWrongType);
-    }
-    v ()->vectorPush (e ());
-    return e.release ();
-}
-
-/*DOC:
-===vector-pop===
- (vector-pop VECTOR) -> VALUE
-
-*/
-//#AFUNC       vector-pop      ml_vector_pop
-//#WIKIFUNC    vector-pop
-MNode*  ml_vector_pop (MNode* cell, MlEnv* mlenv) {
-    MNode*  arg = cell->cdr ();
-    MNodePtr  v;
-
-    if (! arg)
-       throw (uErrorWrongNumber);
-    v = eval (arg->car (), mlenv);
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
-
-    if (v () && v ()->isVector ()) {
-    } else {
-       throw (uErrorWrongType);
-    }
-    return v ()->vectorPop ();
-}
-
-/*DOC:
-===vector-resize===
- (vector-resize N VECTOR) -> VECTOR
-
-*/
-//#AFUNC       vector-resize   ml_vector_resize
-//#WIKIFUNC    vector-resize
-MNode*  ml_vector_resize (MNode* cell, MlEnv* mlenv) {
-    MNode*  arg = cell->cdr ();
-    int  n;
-    MNodePtr  v;
-
-    if (! arg)
-       throw (uErrorWrongNumber);
-    n = eval_int (arg->car (), mlenv);
-    nextNode (arg);
-    v = eval (arg->car (), mlenv);
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
-
-    if (v () && v ()->isVector ()) {
-    } else {
-       throw (uErrorWrongType);
-    }
-    v ()->vectorResize (n);
-    return v.release ();
-}
-
-/*DOC:
-===table===
- (table CONS ...) -> TABLE
-
-*/
-//#AFUNC       table   ml_table
-//#WIKIFUNC    table
-MNode*  ml_table (MNode* cell, MlEnv* mlenv) {
-    MNode*  arg = cell->cdr ();
-    int  n;
-    MNodePtr  ans;
-    MNodePtr  v;
-
-    ans = newMNode_table ();
-    while (arg) {
-       v = eval (arg->car (), mlenv);
-       nextNode (arg);
-       if (v () && v ()->isCons ()) {
-           ans ()->tablePut (to_string (v ()->car ()), v ()->cdr ());
-       } else {
-           throw (uErrorWrongType);
-       }
-    }
-    return ans.release ();
-}
-
-/*DOC:
-===table-get===
- (table-get NAME TABLE) -> VALUE
-
-*/
-//#AFUNC       table-get       ml_table_get
-//#WIKIFUNC    table-get
-MNode*  ml_table_get (MNode* cell, MlEnv* mlenv) {
-    MNode*  arg = cell->cdr ();
-    ustring  name;
-    MNodePtr  v;
-
-    if (! arg)
-       throw (uErrorWrongNumber);
-    name = eval_str (arg->car (), mlenv);
-    nextNode (arg);
-    v = eval (arg->car (), mlenv);
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
-
-    if (v () && v ()->isTable ()) {
-    } else {
-       throw (uErrorWrongType);
-    }
-    return v ()->tableGet (name);
-}
-
-/*DOC:
-===table-put===
- (table-put VALUE NAME TABLE) -> VALUE
-
-*/
-//#AFUNC       table-put       ml_table_put
-//#WIKIFUNC    table-put
-MNode*  ml_table_put (MNode* cell, MlEnv* mlenv) {
-    MNode*  arg = cell->cdr ();
-    MNodePtr  e;
-    ustring  name;
-    MNodePtr  v;
-
-    if (! arg)
-       throw (uErrorWrongNumber);
-    e = eval (arg->car (), mlenv);
-    nextNode (arg);
-    name = eval_str (arg->car (), mlenv);
-    nextNode (arg);
-    v = eval (arg->car (), mlenv);
-    nextNode (arg);
-    if (arg)
-       throw (uErrorWrongNumber);
-
-    if (v () && v ()->isTable ()) {
-    } else {
-       throw (uErrorWrongType);
-    }
-    v ()->tablePut (name, e ());
-    return e.release ();
-}
-
-/*DOC:
 ===push===
  (push ARRAY VALUE...) -> NIL
 

diff --git a/modules/ml-variable.h b/modules/ml-variable.h
index a3fe462..1e833bc 100644 (file)
--- a/modules/ml-variable.h
+++ b/modules/ml-variable.h
@@ -9,15 +9,6 @@ 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);
-MNode*  ml_vector (MNode* cell, MlEnv* mlenv);
-MNode*  ml_vector_get (MNode* cell, MlEnv* mlenv);
-MNode*  ml_vector_put (MNode* cell, MlEnv* mlenv);
-MNode*  ml_vector_push (MNode* cell, MlEnv* mlenv);
-MNode*  ml_vector_pop (MNode* cell, MlEnv* mlenv);
-MNode*  ml_vector_resize (MNode* cell, MlEnv* mlenv);
-MNode*  ml_table (MNode* cell, MlEnv* mlenv);
-MNode*  ml_table_get (MNode* cell, MlEnv* mlenv);
-MNode*  ml_table_put (MNode* cell, MlEnv* mlenv);
 MNode*  ml_push (MNode* cell, MlEnv* mlenv);
 MNode*  ml_pop (MNode* cell, MlEnv* mlenv);
 MNode*  ml_shift (MNode* cell, MlEnv* mlenv);