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--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7 */
   8
   9 #include "scm-hash.hh"
  10
  11 #include <cstdio>
  12 #include <algorithm>
  13 using namespace std;
  14
  15 #include "ly-smobs.icc"
  16
  17 /*
  18   Return: number of objects.
  19 */
  20 int
  21 copy_scm_hashes (SCM dest, SCM src)
  22 {
  23   int k = 0;
  24   for (int i = scm_c_vector_length (src); i--;)
  25     for (SCM s = scm_vector_ref (src, scm_from_int (i)); scm_is_pair (s); s = scm_cdr (s))
  26       {
  27         scm_hashq_set_x (dest, scm_caar (s), scm_cdar (s));
  28         k++;
  29       }
  30   return k;
  31 }
  32
  33 Scheme_hash_table::Scheme_hash_table ()
  34 {
  35   hash_tab_ = SCM_EOL;
  36   smobify_self ();
  37   hash_tab_ = scm_make_vector (scm_from_int (119), SCM_EOL);
  38   elt_count_ = 0;
  39 }
  40
  41 Scheme_hash_table::Scheme_hash_table (Scheme_hash_table const &src)
  42
  43 {
  44   hash_tab_ = SCM_EOL;
  45   elt_count_ = 0;
  46   smobify_self ();
  47
  48   hash_tab_ = scm_make_vector (scm_from_int (max ((int) src.elt_count_, 11)), SCM_EOL);
  49   elt_count_ = copy_scm_hashes (hash_tab_, src.hash_tab_);
  50 }
  51
  52 void
  53 Scheme_hash_table::operator = (Scheme_hash_table const &src)
  54 {
  55   if (&src == this)
  56     return;
  57
  58   hash_tab_ = scm_make_vector (scm_from_int (max ((int) src.elt_count_, 11)), SCM_EOL);
  59   elt_count_ = copy_scm_hashes (hash_tab_, src.hash_tab_);
  60 }
  61
  62 Scheme_hash_table::~Scheme_hash_table ()
  63 {
  64 }
  65
  66 SCM
  67 Scheme_hash_table::mark_smob (SCM s)
  68 {
  69   Scheme_hash_table *me = (Scheme_hash_table *) SCM_CELL_WORD_1 (s);
  70   scm_gc_mark (me->hash_tab_);
  71   return SCM_EOL;
  72 }
  73
  74 int
  75 Scheme_hash_table::print_smob (SCM s, SCM p, scm_print_state*)
  76 {
  77   assert (unsmob (s));
  78   scm_puts ("#<Scheme_hash_table  ", p);
  79   Scheme_hash_table *me = (Scheme_hash_table *) SCM_CELL_WORD_1 (s);
  80   scm_display (me->hash_tab_, p);
  81   scm_puts ("> ", p);
  82   return 1;
  83 }
  84
  85 bool
  86 Scheme_hash_table::try_retrieve (SCM k, SCM *v){
  87
  88   SCM handle = scm_hashq_get_handle (hash_tab_, k);
  89   if (scm_is_pair (handle))
  90     {
  91       *v = scm_cdr (handle);
  92       return true;
  93     }
  94   else
  95     return false;
  96 }
  97
  98 bool
  99 Scheme_hash_table::contains (SCM k) const
 100 {
 101   return scm_is_pair (scm_hashq_get_handle (hash_tab_, k));
 102 }
 103
 104 void
 105 Scheme_hash_table::set (SCM k, SCM v)
 106 {
 107   assert (scm_is_symbol (k));
 108   SCM handle = scm_hashq_create_handle_x (hash_tab_, k, SCM_UNDEFINED);
 109   if (scm_cdr (handle) == SCM_UNDEFINED)
 110     elt_count_++;
 111
 112   scm_set_cdr_x (handle, v);
 113
 114   /*
 115     resize if getting too large.
 116   */
 117   if (elt_count_ > 2 * scm_c_vector_length (hash_tab_))
 118     {
 119       SCM nh = scm_make_vector (scm_from_int (3 * elt_count_ + 1), SCM_EOL);
 120       elt_count_ = copy_scm_hashes (nh, hash_tab_);
 121       hash_tab_ = nh;
 122     }
 123 }
 124
 125 // UGH.
 126 SCM
 127 Scheme_hash_table::get (SCM k) const
 128 {
 129   /*
 130     42 will stick out like a sore thumb, hopefully.
 131   */
 132   return scm_hashq_ref (hash_tab_, k, scm_from_int (42));
 133 }
 134
 135 void
 136 Scheme_hash_table::remove (SCM k)
 137 {
 138   scm_hashq_remove_x (hash_tab_, k);
 139   /* Do not decrease elt_count_ as this may cause underflow.  The exact
 140      value of elt_count_ is not important. */
 141 }
 142
 143 SCM
 144 Scheme_hash_table::to_alist () const
 145 {
 146   SCM lst = SCM_EOL;
 147   for (int i = scm_c_vector_length (hash_tab_); i--;)
 148     for (SCM s = scm_vector_ref (hash_tab_, scm_from_int (i)); scm_is_pair (s);
 149          s = scm_cdr (s))
 150       lst = scm_acons (scm_caar (s), scm_cdar (s), lst);
 151   return lst;
 152 }
 153
 154 IMPLEMENT_SMOBS (Scheme_hash_table);
 155 IMPLEMENT_DEFAULT_EQUAL_P (Scheme_hash_table);