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--2003 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 void
  15 copy_scm_hashes (SCM dest, SCM src)
  16 {
  17   for (int i = SCM_SYMBOL_LENGTH (src); i--;)
  18     for (SCM s = scm_vector_ref (src, SCM_MAKINUM (i)); ly_pair_p(s); s = ly_cdr (s))
  19       {
  20         scm_hashq_set_x (dest, ly_caar (s), ly_cdar (s));
  21       }
  22 }
  23
  24
  25 Scheme_hash_table::Scheme_hash_table ()
  26 {
  27   hash_tab_ = SCM_EOL;
  28   smobify_self ();
  29   hash_tab_ = scm_make_vector (gh_int2scm (119), SCM_EOL);
  30   elt_count_ = 0;
  31 }
  32
  33
  34 Scheme_hash_table::Scheme_hash_table (Scheme_hash_table const &src)
  35
  36 {
  37   hash_tab_ = SCM_EOL;
  38   elt_count_ = src.elt_count_;
  39   smobify_self ();
  40
  41   hash_tab_ = scm_make_vector (gh_int2scm (src.elt_count_ >? 11 ), SCM_EOL);
  42   copy_scm_hashes (hash_tab_, src.hash_tab_);
  43 }
  44
  45 void
  46 Scheme_hash_table::operator = (Scheme_hash_table const & src)
  47 {
  48   if (&src == this)
  49     return;
  50
  51   elt_count_ = src.elt_count_;
  52   hash_tab_ = scm_make_vector (gh_int2scm (src.elt_count_ >? 11), SCM_EOL);
  53   copy_scm_hashes (hash_tab_, src.hash_tab_);
  54 }
  55
  56 SCM
  57 Scheme_hash_table::mark_smob (SCM s)
  58 {
  59   Scheme_hash_table *me = (Scheme_hash_table*) SCM_CELL_WORD_1 (s);
  60   scm_gc_mark (me->hash_tab_);
  61   return SCM_EOL;
  62 }
  63
  64 int
  65 Scheme_hash_table::print_smob (SCM s, SCM p, scm_print_state*)
  66 {
  67   assert (unsmob (s));
  68   char str[1000];
  69   sprintf (str, "#<Scheme_hash_table 0x%0lx ", SCM_UNPACK(s));
  70   Scheme_hash_table *me = (Scheme_hash_table*) SCM_CELL_WORD_1 (s);
  71   scm_display (me->hash_tab_, p);
  72   scm_puts ("> ",p);
  73   return 1;
  74 }
  75
  76 bool
  77 Scheme_hash_table::try_retrieve (SCM k, SCM *v)
  78 {
  79   SCM handle = scm_hashq_get_handle (hash_tab_, k);
  80   if (ly_pair_p (handle))
  81     {
  82       *v = ly_cdr (handle);
  83       return true;
  84     }
  85   else
  86     return false;
  87
  88 }
  89
  90 bool
  91 Scheme_hash_table::elem_b (SCM k) const
  92 {
  93   return ly_pair_p (scm_hashq_get_handle (hash_tab_, k));
  94 }
  95
  96 void
  97 Scheme_hash_table::set (SCM k, SCM v)
  98 {
  99   assert (gh_symbol_p (k));
 100   SCM handle = scm_hashq_create_handle_x (hash_tab_, k, SCM_UNDEFINED);
 101   if (ly_cdr (handle) == SCM_UNDEFINED)
 102     {
 103       elt_count_++;
 104     }
 105
 106   gh_set_cdr_x (handle, v);
 107
 108   /*
 109     resize if getting too large.
 110   */
 111   if (elt_count_ > 2 * SCM_SYMBOL_LENGTH (hash_tab_))
 112     {
 113       SCM nh = scm_make_vector (gh_int2scm (3* elt_count_+1), SCM_EOL);
 114       copy_scm_hashes (nh, hash_tab_);
 115       hash_tab_ = nh;
 116     }
 117
 118 }
 119
 120 // UGH.
 121 SCM
 122 Scheme_hash_table::get (SCM k)const
 123 {
 124   /*
 125     42 will stick out like a sore thumb, hopefully.
 126    */
 127   return scm_hashq_ref (hash_tab_, k, SCM_MAKINUM(42));
 128 }
 129
 130 void
 131 Scheme_hash_table::remove (SCM k)
 132 {
 133   scm_hashq_remove_x (hash_tab_, k);
 134   elt_count_ --;
 135 }
 136
 137 Scheme_hash_table::~Scheme_hash_table ()
 138 {
 139 }
 140
 141 SCM
 142 Scheme_hash_table::to_alist () const
 143 {
 144   SCM l = SCM_EOL;
 145   for (int i = SCM_SYMBOL_LENGTH (hash_tab_); i--;)
 146     for (SCM s = scm_vector_ref (hash_tab_, gh_int2scm (i)); ly_pair_p(s); s = ly_cdr (s))
 147       {
 148         l = scm_acons (ly_caar (s), ly_cdar (s), l);
 149       }
 150   return l;
 151 }
 152
 153
 154
 155
 156
 157 IMPLEMENT_SMOBS (Scheme_hash_table);
 158 IMPLEMENT_DEFAULT_EQUAL_P (Scheme_hash_table);
 159
 160