lily/scm-bintree.cc

   1 /*
   2   scm-bintree.cc --  implement binary trees, an experiment in GC.
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1999 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8  */
   9
  10 #include <stdio.h>
  11 #include "libc-extension.hh"
  12 #include "lily-guile.hh"
  13 #include "main.hh"
  14 #include "debug.hh"
  15
  16
  17
  18
  19 /*
  20   Layout of nodes:
  21
  22   (key . (left_child . right_child))
  23
  24   SCM_EOL is the nil-pointer (should use SCM_NIMP() ?)
  25  */
  26
  27 #define left_child(s) SCM_CADR((s))
  28 #define right_child(s) SCM_CDDR((s))
  29 #define key(s) SCM_CAR((s))
  30
  31 /*
  32   Garble pointers, to prevent unbalanced tree due to ordered inserts.
  33  */
  34
  35 unsigned int
  36 munge (SCM s)
  37 {
  38   const int SHIFT = 18;
  39   return (unsigned int)(s << (32-SHIFT) | s >> SHIFT );
  40 }
  41
  42 SCM
  43 ly_new_bintree_node (SCM val)
  44 {
  45   return gh_cons (val, gh_cons (SCM_EOL, SCM_EOL));
  46 }
  47
  48
  49 /*
  50   add VAL to TREE. TREE must be non-nil
  51  */
  52 void
  53 ly_addto_bintree (SCM *tree, SCM val)
  54 {
  55   while(*tree != SCM_EOL)
  56     {
  57       if (munge (val) <= munge (key (*tree)))
  58         tree = &left_child (*tree);
  59       else
  60         tree = &right_child (*tree);
  61     }
  62
  63   *tree = ly_new_bintree_node (val);
  64 }
  65
  66
  67 /*
  68   find the address of a node in the tree represented by *NODE with key VAL
  69  */
  70 SCM  *
  71 ly_find_in_bintree (SCM *node, SCM val)
  72 {
  73   while (*node != SCM_EOL)
  74     {
  75       if (munge (val) < munge (key(*node) ))
  76         node = &left_child(*node);
  77       else if (munge (val) > munge (key (*node)))
  78         node = &right_child (*node);
  79       else
  80         return node;
  81     }
  82   return node;
  83 }
  84
  85 void
  86 ly_remove_from_bintree (SCM *node)
  87 {
  88   SCM r = right_child  (*node);
  89   SCM l = left_child (*node);
  90
  91   if (r == SCM_EOL)
  92     {
  93       *node = l;
  94     }
  95   else if (l == SCM_EOL)
  96     {
  97       *node = r;
  98     }
  99   else
 100     {
 101       /*deleting from binary trees.  See Knuth's TAOCP.
 102        */
 103       SCM *t = node;
 104       SCM *left_t = &left_child (*t);
 105
 106       /*
 107         INV:  LEFT_T  is the left child of T
 108        */
 109       while (*left_t != SCM_EOL)
 110         {
 111           t = left_t;
 112           left_t = &left_child (*t);
 113         }
 114
 115       /*
 116         POST: T is the leftmost right child of NODE which has no left child,
 117
 118         leftchild (LASTT) == T
 119        */
 120       key(*node) = key(*t);
 121       *left_t = right_child (*t);
 122     }
 123 }
 124
 125
 126 static SCM protect_tree_root;
 127
 128 SCM
 129 ly_protect_scm (SCM s)
 130 {
 131   ly_addto_bintree (&protect_tree_root, s);
 132   return s;
 133 }
 134
 135 SCM
 136 ly_unprotect_scm (SCM s)
 137 {
 138   SCM *to_remove = ly_find_in_bintree (&protect_tree_root, s);
 139
 140   /*
 141     this shouldn't happen, according to me. But it does.
 142    */
 143   if (*to_remove != SCM_EOL)
 144     ly_remove_from_bintree (to_remove);
 145   return s;
 146 }
 147
 148 void
 149 ly_init_protection ()
 150 {
 151   protect_tree_root = scm_protect_object (ly_new_bintree_node(SCM_EOL));
 152   key (protect_tree_root) = protect_tree_root;
 153 }
 154
 155
 156 int
 157 ly_count_elements (SCM tree)
 158 {
 159   if (tree == SCM_EOL)
 160     return 0;
 161   else
 162     return 1 + ly_count_elements (left_child (tree)) + ly_count_elements (right_child( tree));
 163 }
 164
 165 int
 166 ly_tree_depth (SCM tree)
 167 {
 168   if (tree == SCM_EOL)
 169     return 0;
 170   else
 171     return 1 + (ly_tree_depth (left_child (tree)) >? ly_tree_depth (right_child(tree)));
 172 }
 173
 174 void
 175 ly_print_bintree (SCM node)
 176 {
 177 #ifndef NPRINT
 178   if (node == SCM_EOL)
 179     return;
 180   DOUT << "{val = " << key(node) << " \nleft = ";
 181   ly_print_bintree (left_child (node));
 182   DOUT << "\n right =";
 183   ly_print_bintree (right_child (node));
 184   DOUT << "}";
 185 #endif
 186 }
 187
 188
 189 struct Imbalance { int imbalance; int total; };
 190
 191 Imbalance
 192 ly_calc_imbalance (SCM node)
 193 {
 194   Imbalance t;
 195   if (node == SCM_EOL)
 196     {
 197       t.imbalance = 0;
 198       t.total = 0;
 199       return t;
 200     }
 201
 202   Imbalance l = ly_calc_imbalance (left_child (node));
 203   Imbalance r = ly_calc_imbalance (right_child (node));
 204
 205   t.total = l.total + r.total + 1;
 206   int dif = l.total - r.total;
 207   if (dif < 0)
 208      dif = -dif;
 209   t.imbalance = l.imbalance + r.imbalance + dif;
 210   return t;
 211 }
 212