lily/scm-hash.cc

   1 /*
   2   scm-hash.cc --  implement Scheme_hash_table
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1999--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8  */
   9 #include <stdio.h>
  10
  11 #include "scm-hash.hh"
  12 #include "ly-smobs.icc"
  13
  14 /*
  15   Return: number of objects.
  16  */
  17 int
  18 copy_scm_hashes (SCM dest, SCM src)
  19 {
  20   int k = 0;
  21   for (int i = SCM_VECTOR_LENGTH (src); i--;)
  22     for (SCM s = scm_vector_ref (src, SCM_MAKINUM (i)); ly_c_pair_p (s); s = ly_cdr (s))
  23       {
  24         scm_hashq_set_x (dest, ly_caar (s), ly_cdar (s));
  25         k++;
  26       }
  27   return k ;
  28 }
  29
  30
  31 Scheme_hash_table::Scheme_hash_table ()
  32 {
  33   hash_tab_ = SCM_EOL;
  34   smobify_self ();
  35   hash_tab_ = scm_make_vector (scm_int2num (119), SCM_EOL);
  36   elt_count_ = 0;
  37 }
  38
  39
  40 Scheme_hash_table::Scheme_hash_table (Scheme_hash_table const &src)
  41
  42 {
  43   hash_tab_ = SCM_EOL;
  44   elt_count_ = 0;
  45   smobify_self ();
  46
  47   hash_tab_ = scm_make_vector (scm_int2num (src.elt_count_ >? 11 ), SCM_EOL);
  48   elt_count_ = copy_scm_hashes (hash_tab_, src.hash_tab_);
  49 }
  50
  51 void
  52 Scheme_hash_table::operator = (Scheme_hash_table const & src)
  53 {
  54   if (&src == this)
  55     return;
  56
  57   hash_tab_ = scm_make_vector (scm_int2num (src.elt_count_ >? 11), SCM_EOL);
  58   elt_count_ = copy_scm_hashes (hash_tab_, src.hash_tab_);
  59 }
  60
  61 SCM
  62 Scheme_hash_table::mark_smob (SCM s)
  63 {
  64   Scheme_hash_table *me = (Scheme_hash_table*) SCM_CELL_WORD_1 (s);
  65   scm_gc_mark (me->hash_tab_);
  66   return SCM_EOL;
  67 }
  68
  69 int
  70 Scheme_hash_table::print_smob (SCM s, SCM p, scm_print_state*)
  71 {
  72   assert (unsmob (s));
  73   char str[1000];
  74   sprintf (str, "#<Scheme_hash_table 0x%0lx ", SCM_UNPACK (s));
  75   Scheme_hash_table *me = (Scheme_hash_table*) SCM_CELL_WORD_1 (s);
  76   scm_display (me->hash_tab_, p);
  77   scm_puts ("> ",p);
  78   return 1;
  79 }
  80
  81 bool
  82 Scheme_hash_table::try_retrieve (SCM k, SCM *v)
  83 {
  84   SCM handle = scm_hashq_get_handle (hash_tab_, k);
  85   if (ly_c_pair_p (handle))
  86     {
  87       *v = ly_cdr (handle);
  88       return true;
  89     }
  90   else
  91     return false;
  92
  93 }
  94
  95 bool
  96 Scheme_hash_table::contains (SCM k) const
  97 {
  98   return ly_c_pair_p (scm_hashq_get_handle (hash_tab_, k));
  99 }
 100
 101 void
 102 Scheme_hash_table::set (SCM k, SCM v)
 103 {
 104   assert (ly_c_symbol_p (k));
 105   SCM handle = scm_hashq_create_handle_x (hash_tab_, k, SCM_UNDEFINED);
 106   if (ly_cdr (handle) == SCM_UNDEFINED)
 107     {
 108       elt_count_++;
 109     }
 110
 111   scm_set_cdr_x (handle, v);
 112
 113   /*
 114     resize if getting too large.
 115   */
 116   if (elt_count_ > 2 * SCM_VECTOR_LENGTH (hash_tab_))
 117     {
 118       SCM nh = scm_make_vector (scm_int2num (3* elt_count_+1), SCM_EOL);
 119       elt_count_ = copy_scm_hashes (nh, hash_tab_);
 120       hash_tab_ = nh;
 121     }
 122 }
 123
 124 // UGH.
 125 SCM
 126 Scheme_hash_table::get (SCM k)const
 127 {
 128   /*
 129     42 will stick out like a sore thumb, hopefully.
 130    */
 131   return scm_hashq_ref (hash_tab_, k, SCM_MAKINUM (42));
 132 }
 133
 134 void
 135 Scheme_hash_table::remove (SCM k)
 136 {
 137   scm_hashq_remove_x (hash_tab_, k);
 138   /*
 139     don't decrease elt_count_ , as this may cause underflow. The exact
 140     value of elt_count_ is not important.
 141    */
 142 }
 143
 144 Scheme_hash_table::~Scheme_hash_table ()
 145 {
 146 }
 147
 148 SCM
 149 Scheme_hash_table::to_alist () const
 150 {
 151   SCM l = SCM_EOL;
 152   for (int i = SCM_VECTOR_LENGTH (hash_tab_); i--;)
 153     for (SCM s = scm_vector_ref (hash_tab_, scm_int2num (i)); ly_c_pair_p (s); s = ly_cdr (s))
 154       {
 155         l = scm_acons (ly_caar (s), ly_cdar (s), l);
 156       }
 157   return l;
 158 }
 159
 160
 161
 162
 163
 164 IMPLEMENT_SMOBS (Scheme_hash_table);
 165 IMPLEMENT_DEFAULT_EQUAL_P (Scheme_hash_table);
 166
 167