[Commit-gnuradio] pmt/src/lib pmt.cc pmt.h pmt_int.h qa_pmt_prims.cc

[Eric Blossom]

CVSROOT:        /sources/gnuradio
Module name:    pmt
Changes by:     Eric Blossom <eb>       06/07/04 22:15:31

Modified files:
        src/lib        : pmt.cc pmt.h pmt_int.h qa_pmt_prims.cc 

Log message:
        more work in progress: assq/assv/assoc/map QA

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/pmt/src/lib/pmt.cc?cvsroot=gnuradio&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/pmt/src/lib/pmt.h?cvsroot=gnuradio&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/pmt/src/lib/pmt_int.h?cvsroot=gnuradio&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/pmt/src/lib/qa_pmt_prims.cc?cvsroot=gnuradio&r1=1.2&r2=1.3

Patches:
Index: pmt.cc
===================================================================
RCS file: /sources/gnuradio/pmt/src/lib/pmt.cc,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- pmt.cc      4 Jul 2006 20:15:16 -0000       1.4
+++ pmt.cc      4 Jul 2006 22:15:31 -0000       1.5
@@ -91,6 +91,12 @@
   return dynamic_cast<pmt_vector*>(x.get());
 }
 
+static pmt_dict *
+_dict(pmt_t x)
+{
+  return dynamic_cast<pmt_dict*>(x.get());
+}
+
 ////////////////////////////////////////////////////////////////////////////
 //                           Booleans
 ////////////////////////////////////////////////////////////////////////////
@@ -426,6 +432,61 @@
 }
 
 ////////////////////////////////////////////////////////////////////////////
+//                            Dictionaries
+////////////////////////////////////////////////////////////////////////////
+
+pmt_dict::pmt_dict()
+  : d_alist(PMT_NIL)
+{
+}
+
+void
+pmt_dict::set(pmt_t key, pmt_t value)
+{
+  pmt_t        p = pmt_assv(key, d_alist);     // look for (key . value) pair
+  if (pmt_is_pair(p)){                 // found existing pair...
+    pmt_set_cdr(p, value);             // overrwrite cdr with new value
+  }
+  else {                               // not in the dict
+    d_alist = pmt_cons(pmt_cons(key, value), d_alist); // add new (key . 
value) pair
+  }
+}
+
+pmt_t
+pmt_dict::ref(pmt_t key, pmt_t not_found) const
+{
+  pmt_t        p = pmt_assv(key, d_alist);     // look for (key . value) pair
+  if (pmt_is_pair(p))
+    return pmt_cdr(p);
+  else
+    return not_found;
+}
+
+bool
+pmt_dict::has_key(pmt_t key) const
+{
+  return pmt_is_pair(pmt_assv(key, d_alist));
+}
+
+pmt_t
+pmt_dict::items() const
+{
+  return d_alist;
+}
+
+pmt_t
+pmt_dict::keys() const
+{
+  return pmt_map(pmt_car, d_alist);
+}
+
+pmt_t
+pmt_dict::values() const
+{
+  return pmt_map(pmt_cdr, d_alist);
+}
+
+////////////////////////////////////////////////////////////////////////////
 //                          General Functions
 ////////////////////////////////////////////////////////////////////////////
 
@@ -492,3 +553,87 @@
 
   throw pmt_wrong_type("pmt_length", x);
 }
+
+pmt_t
+pmt_assq(pmt_t obj, pmt_t alist)
+{
+  while (pmt_is_pair(alist)){
+    pmt_t p = pmt_car(alist);
+    if (!pmt_is_pair(p))       // malformed alist
+      return PMT_BOOL_F;
+
+    if (pmt_eq(obj, pmt_car(p)))
+      return p;
+
+    alist = pmt_cdr(alist);
+  }
+  return PMT_BOOL_F;
+}
+
+pmt_t
+pmt_assv(pmt_t obj, pmt_t alist)
+{
+  while (pmt_is_pair(alist)){
+    pmt_t p = pmt_car(alist);
+    if (!pmt_is_pair(p))       // malformed alist
+      return PMT_BOOL_F;
+
+    if (pmt_eqv(obj, pmt_car(p)))
+      return p;
+
+    alist = pmt_cdr(alist);
+  }
+  return PMT_BOOL_F;
+}
+
+pmt_t
+pmt_assoc(pmt_t obj, pmt_t alist)
+{
+  while (pmt_is_pair(alist)){
+    pmt_t p = pmt_car(alist);
+    if (!pmt_is_pair(p))       // malformed alist
+      return PMT_BOOL_F;
+
+    if (pmt_equal(obj, pmt_car(p)))
+      return p;
+
+    alist = pmt_cdr(alist);
+  }
+  return PMT_BOOL_F;
+}
+
+pmt_t
+pmt_map(pmt_t proc(pmt_t), pmt_t list)
+{
+  pmt_t r = PMT_NIL;
+
+  while(pmt_is_pair(list)){
+    r = pmt_cons(proc(pmt_car(list)), r);
+    list = pmt_cdr(list);
+  }
+
+  return pmt_reverse_x(r);
+}
+
+pmt_t
+pmt_reverse(pmt_t listx)
+{
+  pmt_t list = listx;
+  pmt_t r = PMT_NIL;
+
+  while(pmt_is_pair(list)){
+    r = pmt_cons(pmt_car(list), r);
+    list = pmt_cdr(list);
+  }
+  if (pmt_is_null(list))
+    return r;
+  else
+    throw pmt_wrong_type("pmt_reverse", listx);
+}
+
+pmt_t
+pmt_reverse_x(pmt_t list)
+{
+  // FIXME do it destructively
+  return pmt_reverse(list);
+}

Index: pmt.h
===================================================================
RCS file: /sources/gnuradio/pmt/src/lib/pmt.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- pmt.h       4 Jul 2006 03:49:36 -0000       1.5
+++ pmt.h       4 Jul 2006 22:15:31 -0000       1.6
@@ -381,8 +381,8 @@
 //! Return true if \p key exists in \p dict
 bool  pmt_dict_has_key(pmt_t dict, pmt_t key);
 
-//! If \p key exists in \p dict, return associated value; otherwise return \p 
default_value
-pmt_t pmt_dict_ref(pmt_t dict, pmt_t key, pmt_t default_value);
+//! If \p key exists in \p dict, return associated value; otherwise return \p 
not_found.
+pmt_t pmt_dict_ref(pmt_t dict, pmt_t key, pmt_t not_found);
 
 //! Return list of (key . value) pairs
 pmt_t pmt_dict_items(pmt_t dict);
@@ -429,6 +429,67 @@
 //! Return the number of elements in v
 size_t pmt_length(pmt_t v);
 
+/*!
+ * \brief Find the first pair in \p alist whose car field is \p obj
+ *  and return that pair.
+ *
+ * \p alist (for "association list") must be a list of pairs.  If no pair
+ * in \p alist has \p obj as its car then #f is returned.
+ * Uses pmt_eq to compare \p obj with car fields of the pairs in \p alist.
+ */
+pmt_t pmt_assq(pmt_t obj, pmt_t alist);
+
+/*!
+ * \brief Find the first pair in \p alist whose car field is \p obj
+ *  and return that pair.
+ *
+ * \p alist (for "association list") must be a list of pairs.  If no pair
+ * in \p alist has \p obj as its car then #f is returned.
+ * Uses pmt_eqv to compare \p obj with car fields of the pairs in \p alist.
+ */
+pmt_t pmt_assv(pmt_t obj, pmt_t alist);
+
+/*!
+ * \brief Find the first pair in \p alist whose car field is \p obj
+ *  and return that pair.
+ *
+ * \p alist (for "association list") must be a list of pairs.  If no pair
+ * in \p alist has \p obj as its car then #f is returned.
+ * Uses pmt_equal to compare \p obj with car fields of the pairs in \p alist.
+ */
+pmt_t pmt_assoc(pmt_t obj, pmt_t alist);
+
+/*!
+ * \brief Apply \p proc element-wise to the elements of list and returns
+ * a list of the results, in order.
+ *
+ * \p list must be a list.  The dynamic order in which \p proc is
+ * applied to the elements of \p list is unspecified.
+ */
+pmt_t pmt_map(pmt_t proc(pmt_t), pmt_t list);
+
+/*!
+ * \brief reverse \p list.
+ *
+ * \p list must be a proper list.
+ */
+pmt_t pmt_reverse(pmt_t list);
+
+/*!
+ * \brief destructively reverse \p list.
+ *
+ * \p list must be a proper list.
+ */
+pmt_t pmt_reverse_x(pmt_t list);
+
+/*!
+ * \brief (acons x y a) == (cons (cons x y) a)
+ */
+inline static pmt_t
+pmt_acons(pmt_t x, pmt_t y, pmt_t a)
+{
+  return pmt_cons(pmt_cons(x, y), a);
+}
 
 /*
  * ------------------------------------------------------------------------

Index: pmt_int.h
===================================================================
RCS file: /sources/gnuradio/pmt/src/lib/pmt_int.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- pmt_int.h   4 Jul 2006 20:15:16 -0000       1.3
+++ pmt_int.h   4 Jul 2006 22:15:31 -0000       1.4
@@ -50,6 +50,7 @@
   virtual bool is_null()    const { return false; }
   virtual bool is_pair()    const { return false; }
   virtual bool is_vector()  const { return false; }
+  virtual bool is_dict()    const { return false; }
 };
 
 class pmt_bool : public pmt_base
@@ -157,4 +158,21 @@
   pmt_t _ref(size_t k) const { return d_v[k]; }
 };
 
+class pmt_dict : public pmt_base
+{
+  pmt_t                d_alist;        // list of (key . value) pairs
+
+public:
+  pmt_dict();
+  //~pmt_dict();
+
+  bool  is_dict() const { return true; }
+  void  set(pmt_t key, pmt_t value);
+  pmt_t ref(pmt_t key, pmt_t default_value) const;
+  bool  has_key(pmt_t key) const;
+  pmt_t items() const;
+  pmt_t keys() const;
+  pmt_t values() const;
+};
+
 #endif /* INCLUDED_PMT_INT_H */

Index: qa_pmt_prims.cc
===================================================================
RCS file: /sources/gnuradio/pmt/src/lib/qa_pmt_prims.cc,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- qa_pmt_prims.cc     4 Jul 2006 20:15:16 -0000       1.2
+++ qa_pmt_prims.cc     4 Jul 2006 22:15:31 -0000       1.3
@@ -228,4 +228,24 @@
 qa_pmt_prims::test_misc()
 {
   CPPUNIT_ASSERT_THROW(pmt_length(PMT_NIL), pmt_wrong_type);
+
+  pmt_t k0 = pmt_string_to_symbol("k0");
+  pmt_t k1 = pmt_string_to_symbol("k1");
+  pmt_t k2 = pmt_string_to_symbol("k2");
+  pmt_t k3 = pmt_string_to_symbol("k3");
+  pmt_t v0 = pmt_string_to_symbol("v0");
+  pmt_t v1 = pmt_string_to_symbol("v1");
+  pmt_t v2 = pmt_string_to_symbol("v2");
+  pmt_t p0 = pmt_cons(k0, v0);
+  pmt_t p1 = pmt_cons(k1, v1);
+  pmt_t p2 = pmt_cons(k2, v2);
+  
+  pmt_t alist = pmt_cons(p0, pmt_cons(p1, pmt_cons(p2, PMT_NIL)));
+  CPPUNIT_ASSERT(pmt_eq(p1, pmt_assv(k1, alist)));
+  CPPUNIT_ASSERT(pmt_eq(PMT_BOOL_F, pmt_assv(k3, alist)));
+  
+  pmt_t keys = pmt_cons(k0, pmt_cons(k1, pmt_cons(k2, PMT_NIL)));
+  pmt_t vals = pmt_cons(v0, pmt_cons(v1, pmt_cons(v2, PMT_NIL)));
+  CPPUNIT_ASSERT(pmt_equal(keys, pmt_map(pmt_car, alist)));
+  CPPUNIT_ASSERT(pmt_equal(vals, pmt_map(pmt_cdr, alist)));
 }