+MSRCS += ml-texp.cc
MSRCS += ml-imagesize.cc
MSRCS += ml-security.cc
MLDADD += -lmd
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;
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;
} 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);
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);
return cons.cdr;
};
MNode* vectorGet (size_t pos);
+ size_t vectorSize ();
void vectorPut (size_t pos, MNode* e);
void vectorPush (MNode* e);
MNode* vectorPop ();
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;
}
/*DOC:
===string-join===
- (string-join TEXT [STRING | ARRAY | LIST]...) -> STRING
+ (string-join TEXT [STRING | ARRAY | LIST | VECTOR]...) -> STRING
*/
//#AFUNC string-join ml_string_join
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)
--- /dev/null
+#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 ();
+}
+
--- /dev/null
+#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 */
}
/*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
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);