Added most of the support for a new PMT type: tuple.

More QA code coming soon.

diff --git a/gruel/src/include/gruel/pmt.h b/gruel/src/include/gruel/pmt.h
index de0998b5e1bf6e51cc58da7e7ac2182c47ce648f..ed337a885a3ae392197fd123ed3fcedccebb3e77 100644 (file)
--- a/gruel/src/include/gruel/pmt.h
+++ b/gruel/src/include/gruel/pmt.h
@@ -235,6 +235,42 @@ pmt_t pmt_cddr(pmt_t pair);
 pmt_t pmt_caddr(pmt_t pair);
 pmt_t pmt_cadddr(pmt_t pair);
 
+/*
+ * ------------------------------------------------------------------------
+ *                               Tuples
+ *
+ * Store a fixed number of objects.  Tuples are not modifiable, and thus
+ * are excellent for use as messages.  Indexing is zero based.
+ * Access time to an element is O(1).
+ * ------------------------------------------------------------------------
+ */
+
+//! Return true if \p x is a tuple, othewise false.
+bool pmt_is_tuple(pmt_t x);
+
+pmt_t pmt_make_tuple();
+pmt_t pmt_make_tuple(const pmt_t &e0);
+pmt_t pmt_make_tuple(const pmt_t &e0, const pmt_t &e1);
+pmt_t pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2);
+pmt_t pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3);
+pmt_t pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4);
+pmt_t pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4, const pmt_t &e5);
+pmt_t pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4, const pmt_t &e5, const pmt_t &e6);
+pmt_t pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4, const pmt_t &e5, const pmt_t &e6, const pmt_t &e7);
+pmt_t pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4, const pmt_t &e5, const pmt_t &e6, const pmt_t &e7, const pmt_t &e8);
+pmt_t pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4, const pmt_t &e5, const pmt_t &e6, const pmt_t &e7, const pmt_t &e8, const pmt_t &e9);
+
+/*!
+ * If \p x is a vector or proper list, return a tuple containing the elements of x
+ */
+pmt_t pmt_to_tuple(const pmt_t &x);
+
+/*!
+ * Return the contents of position \p k of \p tuple.
+ * \p k must be a valid index of \p tuple.
+ */
+pmt_t pmt_tuple_ref(const pmt_t &tuple, size_t k);
+
 /*
  * ------------------------------------------------------------------------
  *                            Vectors

diff --git a/gruel/src/lib/pmt/pmt.cc b/gruel/src/lib/pmt/pmt.cc
index fbf557be1e2577a3074928e7ddfba315a6b3e340..8bf5b2dea51069f46698cb03ee9da2fd8c1be308 100644 (file)
--- a/gruel/src/lib/pmt/pmt.cc
+++ b/gruel/src/lib/pmt/pmt.cc
@@ -126,6 +126,12 @@ _vector(pmt_t x)
   return dynamic_cast<pmt_vector*>(x.get());
 }
 
+static pmt_tuple *
+_tuple(pmt_t x)
+{
+  return dynamic_cast<pmt_tuple*>(x.get());
+}
+
 static pmt_uniform_vector *
 _uniform_vector(pmt_t x)
 {
@@ -494,6 +500,200 @@ pmt_vector_fill(pmt_t vector, pmt_t obj)
   _vector(vector)->fill(obj);
 }
 
+////////////////////////////////////////////////////////////////////////////
+//                             Tuples
+////////////////////////////////////////////////////////////////////////////
+
+pmt_tuple::pmt_tuple(size_t len)
+  : d_v(len)
+{
+}
+
+pmt_t
+pmt_tuple::ref(size_t k) const
+{
+  if (k >= length())
+    throw pmt_out_of_range("pmt_tuple_ref", pmt_from_long(k));
+  return d_v[k];
+}
+
+bool
+pmt_is_tuple(pmt_t obj)
+{
+  return obj->is_tuple();
+}
+
+pmt_t
+pmt_tuple_ref(const pmt_t &tuple, size_t k)
+{
+  if (!tuple->is_tuple())
+    throw pmt_wrong_type("pmt_tuple_ref", tuple);
+  return _tuple(tuple)->ref(k);
+}
+
+// for (i=0; i < 10; i++)
+//   make_constructor()
+
+pmt_t
+pmt_make_tuple()
+{
+  return pmt_t(new pmt_tuple(0));
+}
+
+pmt_t
+pmt_make_tuple(const pmt_t &e0)
+{
+  pmt_tuple *t = new pmt_tuple(1);
+  t->_set(0, e0);
+  return pmt_t(t);
+}
+
+pmt_t
+pmt_make_tuple(const pmt_t &e0, const pmt_t &e1)
+{
+  pmt_tuple *t = new pmt_tuple(2);
+  t->_set(0, e0);
+  t->_set(1, e1);
+  return pmt_t(t);
+}
+
+pmt_t
+pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2)
+{
+  pmt_tuple *t = new pmt_tuple(3);
+  t->_set(0, e0);
+  t->_set(1, e1);
+  t->_set(2, e2);
+  return pmt_t(t);
+}
+
+pmt_t
+pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3)
+{
+  pmt_tuple *t = new pmt_tuple(4);
+  t->_set(0, e0);
+  t->_set(1, e1);
+  t->_set(2, e2);
+  t->_set(3, e3);
+  return pmt_t(t);
+}
+
+pmt_t
+pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4)
+{
+  pmt_tuple *t = new pmt_tuple(5);
+  t->_set(0, e0);
+  t->_set(1, e1);
+  t->_set(2, e2);
+  t->_set(3, e3);
+  t->_set(4, e4);
+  return pmt_t(t);
+}
+
+pmt_t
+pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4, const pmt_t &e5)
+{
+  pmt_tuple *t = new pmt_tuple(6);
+  t->_set(0, e0);
+  t->_set(1, e1);
+  t->_set(2, e2);
+  t->_set(3, e3);
+  t->_set(4, e4);
+  t->_set(5, e5);
+  return pmt_t(t);
+}
+
+pmt_t
+pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4, const pmt_t &e5, const pmt_t &e6)
+{
+  pmt_tuple *t = new pmt_tuple(7);
+  t->_set(0, e0);
+  t->_set(1, e1);
+  t->_set(2, e2);
+  t->_set(3, e3);
+  t->_set(4, e4);
+  t->_set(5, e5);
+  t->_set(6, e6);
+  return pmt_t(t);
+}
+
+pmt_t
+pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4, const pmt_t &e5, const pmt_t &e6, const pmt_t &e7)
+{
+  pmt_tuple *t = new pmt_tuple(8);
+  t->_set(0, e0);
+  t->_set(1, e1);
+  t->_set(2, e2);
+  t->_set(3, e3);
+  t->_set(4, e4);
+  t->_set(5, e5);
+  t->_set(6, e6);
+  t->_set(7, e7);
+  return pmt_t(t);
+}
+
+pmt_t
+pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4, const pmt_t &e5, const pmt_t &e6, const pmt_t &e7, const pmt_t &e8)
+{
+  pmt_tuple *t = new pmt_tuple(9);
+  t->_set(0, e0);
+  t->_set(1, e1);
+  t->_set(2, e2);
+  t->_set(3, e3);
+  t->_set(4, e4);
+  t->_set(5, e5);
+  t->_set(6, e6);
+  t->_set(7, e7);
+  t->_set(8, e8);
+  return pmt_t(t);
+}
+
+pmt_t
+pmt_make_tuple(const pmt_t &e0, const pmt_t &e1, const pmt_t &e2, const pmt_t &e3, const pmt_t &e4, const pmt_t &e5, const pmt_t &e6, const pmt_t &e7, const pmt_t &e8, const pmt_t &e9)
+{
+  pmt_tuple *t = new pmt_tuple(10);
+  t->_set(0, e0);
+  t->_set(1, e1);
+  t->_set(2, e2);
+  t->_set(3, e3);
+  t->_set(4, e4);
+  t->_set(5, e5);
+  t->_set(6, e6);
+  t->_set(7, e7);
+  t->_set(8, e8);
+  t->_set(9, e9);
+  return pmt_t(t);
+}
+
+pmt_t
+pmt_to_tuple(const pmt_t &x)
+{
+  if (x->is_tuple())           // already one
+    return x;
+
+  size_t len = pmt_length(x);
+  pmt_tuple *t = new pmt_tuple(len);
+
+  if (x->is_vector()){
+    for (size_t i = 0; i < len; i++)
+      t->_set(i, _vector(x)->ref(i));
+    return pmt_t(t);
+  }
+
+  if (x->is_pair()){
+    pmt_t y = x;
+    for (size_t i = 0; i < len; i++){
+      t->_set(i, pmt_car(y));
+      y = pmt_cdr(x);
+    }
+    return pmt_t(t);
+  }
+
+  throw pmt_wrong_type("pmt_to_tuple", x);
+}
+
+
+
 ////////////////////////////////////////////////////////////////////////////
 //                       Uniform Numeric Vectors
 ////////////////////////////////////////////////////////////////////////////
@@ -757,11 +957,15 @@ pmt_length(const pmt_t& x)
   if (x->is_uniform_vector())
     return _uniform_vector(x)->length();
 
-  if (x->is_null()) return 0;
+  if (x->is_tuple())
+    return _tuple(x)->length();
+
+  if (x->is_null())
+    return 0;
 
   if (x->is_pair()) {
     size_t length=1;
-       pmt_t it = pmt_cdr(x);
+    pmt_t it = pmt_cdr(x);
     while (pmt_is_pair(it)){
       length++;
       it = pmt_cdr(it);

diff --git a/gruel/src/lib/pmt/pmt_int.h b/gruel/src/lib/pmt/pmt_int.h
index 9aac322a7fc7085cce6b56f97f21d653a590152e..ed47249b12a5e192698f25a5e0b2f451d26abf47 100644 (file)
--- a/gruel/src/lib/pmt/pmt_int.h
+++ b/gruel/src/lib/pmt/pmt_int.h
@@ -48,6 +48,7 @@ public:
   virtual bool is_complex() const { return false; }
   virtual bool is_null()    const { return false; }
   virtual bool is_pair()    const { return false; }
+  virtual bool is_tuple()   const { return false; }
   virtual bool is_vector()  const { return false; }
   virtual bool is_dict()    const { return false; }
   virtual bool is_any()     const { return false; }
@@ -180,6 +181,22 @@ public:
   pmt_t _ref(size_t k) const { return d_v[k]; }
 };
 
+class pmt_tuple : public pmt_base
+{
+  std::vector<pmt_t>   d_v;
+
+public:
+  pmt_tuple(size_t len);
+  //~pmt_tuple();
+
+  bool is_tuple() const { return true; }
+  pmt_t ref(size_t k) const;
+  size_t length() const { return d_v.size(); }
+
+  pmt_t _ref(size_t k) const { return d_v[k]; }
+  void _set(size_t k, pmt_t v) { d_v[k] = v; }
+};
+
 class pmt_dict : public pmt_base
 {
   pmt_t                d_alist;        // list of (key . value) pairs

diff --git a/gruel/src/lib/pmt/qa_pmt_prims.cc b/gruel/src/lib/pmt/qa_pmt_prims.cc
index b81354721dbad1b664fad64936991aecdf3ab14f..d31e3fabf47e15b6cf36154249d954a7a32fecb8 100644 (file)
--- a/gruel/src/lib/pmt/qa_pmt_prims.cc
+++ b/gruel/src/lib/pmt/qa_pmt_prims.cc
@@ -193,6 +193,69 @@ qa_pmt_prims::test_vectors()
     CPPUNIT_ASSERT_EQUAL(s0, pmt_vector_ref(v1, i));
 }
 
+static void
+check_tuple(size_t len, const std::vector<pmt_t> &s, pmt_t t)
+{
+  CPPUNIT_ASSERT_EQUAL(true, pmt_is_tuple(t));
+  CPPUNIT_ASSERT_EQUAL(len, pmt_length(t));
+
+  for (size_t i = 0; i < len; i++)
+    CPPUNIT_ASSERT_EQUAL(s[i], pmt_tuple_ref(t, i));
+
+}
+
+void
+qa_pmt_prims::test_tuples()
+{
+  pmt_t t0 = pmt_make_tuple();
+  CPPUNIT_ASSERT_EQUAL(size_t(0), pmt_length(t0));
+
+  std::vector<pmt_t> s(10);
+  for (size_t i = 0; i < 10; i++){
+    std::ostringstream os;
+    os << "s" << i;
+    s[i] = pmt_string_to_symbol(os.str());
+  }
+
+  pmt_t t;
+
+  t = pmt_make_tuple();
+  check_tuple(0, s, t);
+
+  t = pmt_make_tuple(s[0]);
+  check_tuple(1, s, t);
+
+  t = pmt_make_tuple(s[0], s[1]);
+  check_tuple(2, s, t);
+
+  t = pmt_make_tuple(s[0], s[1], s[2]);
+  check_tuple(3, s, t);
+
+  t = pmt_make_tuple(s[0], s[1], s[2], s[3]);
+  check_tuple(4, s, t);
+
+  t = pmt_make_tuple(s[0], s[1], s[2], s[3], s[4]);
+  check_tuple(5, s, t);
+
+  t = pmt_make_tuple(s[0], s[1], s[2], s[3], s[4], s[5]);
+  check_tuple(6, s, t);
+
+  t = pmt_make_tuple(s[0], s[1], s[2], s[3], s[4], s[5], s[6]);
+  check_tuple(7, s, t);
+
+  t = pmt_make_tuple(s[0], s[1], s[2], s[3], s[4], s[5], s[6], s[7]);
+  check_tuple(8, s, t);
+
+  t = pmt_make_tuple(s[0], s[1], s[2], s[3], s[4], s[5], s[6], s[7], s[8]);
+  check_tuple(9, s, t);
+
+  t = pmt_make_tuple(s[0], s[1], s[2], s[3], s[4], s[5], s[6], s[7], s[8], s[9]);
+  check_tuple(10, s, t);
+
+  t = pmt_make_tuple(s[0], s[1], s[2]);
+  CPPUNIT_ASSERT_THROW(pmt_tuple_ref(t, 3), pmt_out_of_range);
+}
+
 void
 qa_pmt_prims::test_equivalence()
 {
@@ -436,3 +499,4 @@ qa_pmt_prims::test_sets()
   CPPUNIT_ASSERT(!pmt_subsetp(l2,l1));
   CPPUNIT_ASSERT(!pmt_subsetp(l3,l2));
 }
+

diff --git a/gruel/src/lib/pmt/qa_pmt_prims.h b/gruel/src/lib/pmt/qa_pmt_prims.h
index effb3a097a635fad976257a0d1d11436defd7f52..2fe473c43b5c81888f7124916c7ad6adc3401c7d 100644 (file)
--- a/gruel/src/lib/pmt/qa_pmt_prims.h
+++ b/gruel/src/lib/pmt/qa_pmt_prims.h
@@ -35,6 +35,7 @@ class qa_pmt_prims : public CppUnit::TestCase {
   CPPUNIT_TEST(test_complexes);
   CPPUNIT_TEST(test_pairs);
   CPPUNIT_TEST(test_vectors);
+  CPPUNIT_TEST(test_tuples);
   CPPUNIT_TEST(test_equivalence);
   CPPUNIT_TEST(test_misc);
   CPPUNIT_TEST(test_dict);
@@ -53,6 +54,7 @@ class qa_pmt_prims : public CppUnit::TestCase {
   void test_complexes();
   void test_pairs();
   void test_vectors();
+  void test_tuples();
   void test_equivalence();
   void test_misc();
   void test_dict();