1 /* rbtree.c                                               -*- coding: utf-8; -*-
2  *
3  *   Copyright (c) 2010-2021  Takashi Kato <ktakashi@ymail.com>
4  *
5  *   Redistribution and use in source and binary forms, with or without
6  *   modification, are permitted provided that the following conditions
7  *   are met:
8  *
9  *   1. Redistributions of source code must retain the above copyright
10  *      notice, this list of conditions and the following disclaimer.
11  *
12  *   2. Redistributions in binary form must reproduce the above copyright
13  *      notice, this list of conditions and the following disclaimer in the
14  *      documentation and/or other materials provided with the distribution.
15  *
16  *   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
17  *   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
18  *   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
19  *   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
20  *   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
21  *   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
22  *   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
23  *   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
24  *   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
25  *   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26  *   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27  *
28  *  $Id: $
29  */
30 #define LIBSAGITTARIUS_BODY
31 #include "sagittarius/private/treemap.h"
32 #include "sagittarius/private/error.h"
33 #include "sagittarius/private/vm.h"
34 
35 /*
36    Based on Java's implementation
37  */
38 #define BLACK ((char)0)
39 #define RED   ((char)1)
40 
41 typedef struct node_rec_t
42 {
43   intptr_t key;
44   intptr_t value;
45   char     color;
46   struct node_rec_t *parent;
47   struct node_rec_t *left;
48   struct node_rec_t *right;
49 } node_t;
50 
new_node(intptr_t key,node_t * parent)51 static node_t* new_node(intptr_t key, node_t *parent)
52 {
53   node_t *n = SG_NEW(node_t);
54   n->key = key;
55   n->parent = parent;
56   n->left = NULL;
57   n->right = NULL;
58   n->color = BLACK;
59   return n;
60 }
61 
62 #define NODE(n) 	((node_t*)n)
63 #if 0
64 #define SET_COLOR(n, c) if (n) {NODE(n)->color = (c);}
65 #define PARENT_OF(p)    ((p) ? NODE(p)->parent : NULL)
66 #define LEFT_OF(p)      ((p) ? NODE(p)->left : NULL)
67 #define RIGHT_OF(p)     ((p) ? NODE(p)->right : NULL)
68 #define COLOR_OF(p)     ((p) ? NODE(p)->color : BLACK)
69 #else
set_color(node_t * n,char color)70 static void set_color(node_t *n, char color)
71 {
72   if (n) n->color = color;
73 }
parent_of(node_t * p)74 static node_t* parent_of(node_t *p)
75 {
76   return (p) ? NODE(p)->parent : NULL;
77 }
left_of(node_t * p)78 static node_t* left_of(node_t *p)
79 {
80   return (p) ? NODE(p)->left : NULL;
81 }
right_of(node_t * p)82 static node_t* right_of(node_t *p)
83 {
84   return (p) ? NODE(p)->right : NULL;
85 }
color_of(node_t * p)86 static char color_of(node_t *p)
87 {
88   return (p) ? NODE(p)->color : BLACK;
89 }
90 
91 #define SET_COLOR(n, c) set_color(NODE(n), c)
92 #define PARENT_OF(p)    parent_of(NODE(p))
93 #define LEFT_OF(p)      left_of(NODE(p))
94 #define RIGHT_OF(p)     right_of(NODE(p))
95 #define COLOR_OF(p)     color_of(NODE(p))
96 #endif
97 
successor(node_t * t)98 static node_t* successor(node_t *t)
99 {
100   if (t == NULL) return NULL;
101   else if (t->right != NULL) {
102     node_t *p = t->right;
103     while (p->left != NULL) p = p->left;
104     return p;
105   } else {
106     node_t *p = t->parent;
107     node_t *ch = t;
108     while (p != NULL && ch == p->right) {
109       ch = p;
110       p = p->parent;
111     }
112     return p;
113   }
114 }
115 
predecessor(node_t * t)116 static node_t* predecessor(node_t *t)
117 {
118   if (t == NULL) return NULL;
119   else if (t->left != NULL) {
120     node_t *p = t->left;
121     while (p->right != NULL) p = p->right;
122     return p;
123   } else {
124     node_t *p = t->parent;
125     node_t *ch = t;
126     while (p != NULL && ch == p->left) {
127       ch = p;
128       p = p->parent;
129     }
130     return p;
131   }
132 }
133 
134 
rotate_left(SgTreeMap * tm,node_t * p)135 static void rotate_left(SgTreeMap *tm, node_t *p)
136 {
137   if (p != NULL) {
138     node_t *r = p->right;
139     p->right = r->left;
140     if (r->left != NULL) r->left->parent = p;
141     r->parent = p->parent;
142     if (p->parent == NULL) tm->root = (intptr_t)r;
143     else if (p->parent->left == p) p->parent->left = r;
144     else p->parent->right = r;
145     r->left = p;
146     p->parent = r;
147   }
148 }
149 
rotate_right(SgTreeMap * tm,node_t * p)150 static void rotate_right(SgTreeMap *tm, node_t *p)
151 {
152   if (p != NULL) {
153     node_t *l = p->left;
154     p->left = l->right;
155     if (l->right != NULL) l->right->parent = p;
156     l->parent = p->parent;
157     if (p->parent == NULL) tm->root = (intptr_t)l;
158     else if (p->parent->right == p) p->parent->right = l;
159     else p->parent->left = l;
160     l->right = p;
161     p->parent = l;
162   }
163 }
164 
fix_after_insertion(SgTreeMap * tm,node_t * x)165 static void fix_after_insertion(SgTreeMap *tm, node_t *x)
166 {
167   x->color = RED;
168   while (x != NULL && NODE(tm->root) != x && x->parent->color == RED) {
169     if (PARENT_OF(x) == LEFT_OF(PARENT_OF(PARENT_OF(x)))) {
170       node_t *y = RIGHT_OF(PARENT_OF(PARENT_OF(x)));
171       if (COLOR_OF(y) == RED) {
172 	SET_COLOR(PARENT_OF(x), BLACK);
173 	SET_COLOR(y, BLACK);
174 	SET_COLOR(PARENT_OF(PARENT_OF(x)), RED);
175 	x = PARENT_OF(PARENT_OF(x));
176       } else {
177 	if (x == RIGHT_OF(PARENT_OF(x))) {
178 	  x = PARENT_OF(x);
179 	  rotate_left(tm, x);
180 	}
181 	SET_COLOR(PARENT_OF(x), BLACK);
182 	SET_COLOR(PARENT_OF(PARENT_OF(x)), RED);
183 	rotate_right(tm, PARENT_OF(PARENT_OF(x)));
184       }
185     } else {
186       node_t *y = LEFT_OF(PARENT_OF(PARENT_OF(x)));
187       if (COLOR_OF(y) == RED) {
188 	SET_COLOR(PARENT_OF(x), BLACK);
189 	SET_COLOR(y, BLACK);
190 	SET_COLOR(PARENT_OF(PARENT_OF(x)), RED);
191 	x = PARENT_OF(PARENT_OF(x));
192       } else {
193 	if (x == LEFT_OF(PARENT_OF(x))) {
194 	  x = PARENT_OF(x);
195 	  rotate_right(tm, x);
196 	}
197 	SET_COLOR(PARENT_OF(x), BLACK);
198 	SET_COLOR(PARENT_OF(PARENT_OF(x)), RED);
199 	rotate_left(tm, PARENT_OF(PARENT_OF(x)));
200       }
201     }
202   }
203   NODE(tm->root)->color = BLACK;
204 }
205 
get_entry(SgTreeMap * tm,intptr_t key)206 static node_t* get_entry(SgTreeMap *tm, intptr_t key)
207 {
208   intptr_t k = key;
209   SgTreeCompareProc *cpr = SG_TREEMAP_C_PROC(tm, cmp);
210   node_t *p = (node_t*)tm->root;
211   while (p != NULL) {
212     int cmp = cpr(tm, k, p->key);
213     if (cmp < 0) {
214       p = p->left;
215     } else if (cmp > 0) {
216       p = p->right;
217     } else {
218       return p;
219     }
220   }
221   return NULL;
222 }
223 
rb_ref(SgTreeMap * tm,intptr_t key)224 static SgTreeEntry* rb_ref(SgTreeMap *tm, intptr_t key)
225 {
226   return (SgTreeEntry*)get_entry(tm, key);
227 }
228 
get_higher_entry(SgTreeMap * tm,intptr_t key)229 static node_t* get_higher_entry(SgTreeMap *tm, intptr_t key)
230 {
231   node_t *p = NODE(tm->root);
232   while (p != NULL) {
233     int cmp = SG_TREEMAP_C_PROC(tm, cmp)(tm, key, p->key);
234     if (cmp < 0) {
235       if (p->left != NULL) p = p->left;
236       else return p;
237     } else {
238       if (p->right != NULL) p = p->right;
239       else {
240 	node_t *parent = p->parent;
241 	node_t *ch = p;
242 	while (parent != NULL && ch == parent->right) {
243 	  ch = parent;
244 	  parent = parent->parent;
245 	}
246 	return parent;
247       }
248     }
249   }
250   return NULL;
251 }
252 
rb_higher(SgTreeMap * tm,intptr_t key)253 static SgTreeEntry* rb_higher(SgTreeMap *tm, intptr_t key)
254 {
255   return (SgTreeEntry*)get_higher_entry(tm, key);
256 }
257 
get_lower_entry(SgTreeMap * tm,intptr_t key)258 static node_t* get_lower_entry(SgTreeMap *tm, intptr_t key)
259 {
260   node_t *p = NODE(tm->root);
261   while (p != NULL) {
262     int cmp = SG_TREEMAP_C_PROC(tm, cmp)(tm, key, p->key);
263     if (cmp > 0) {
264       if (p->right != NULL) p = p->right;
265       else return p;
266     } else {
267       if (p->left != NULL) p = p->left;
268       else {
269 	node_t *parent = p->parent;
270 	node_t *ch = p;
271 	while (parent != NULL && ch == parent->left) {
272 	  ch = parent;
273 	  parent = parent->parent;
274 	}
275 	return parent;
276       }
277     }
278   }
279   return NULL;
280 }
281 
rb_lower(SgTreeMap * tm,intptr_t key)282 static SgTreeEntry* rb_lower(SgTreeMap *tm, intptr_t key)
283 {
284   return (SgTreeEntry*)get_lower_entry(tm, key);
285 }
286 
287 /* only creates an entry and return it */
rb_set(SgTreeMap * tm,intptr_t key)288 static SgTreeEntry* rb_set(SgTreeMap *tm, intptr_t key)
289 {
290   node_t *t = (node_t*)tm->root;
291   if (t == NULL) {
292     node_t *nn = new_node(key, NULL);
293     tm->root = (intptr_t)nn;
294     tm->entryCount++;
295     return (SgTreeEntry*)nn;
296   } else {
297     int cmp;
298     node_t *parent, *e;
299     SgTreeCompareProc *cpr = SG_TREEMAP_C_PROC(tm, cmp);
300     do {
301       parent = t;
302       cmp = cpr(tm, (intptr_t)key, t->key);
303       if (cmp < 0) {
304 	t = t->left;
305       } else if (cmp > 0) {
306 	t = t->right;
307       } else {
308 	return (SgTreeEntry*)t;
309       }
310     } while (t != NULL);
311     e = new_node(key, parent);
312     if (cmp < 0) {
313       parent->left = e;
314     } else {
315       parent->right = e;
316     }
317     /* fprintf(stderr, "cmp %d, key: %ld\n", cmp, SG_INT_VALUE(key)); */
318     fix_after_insertion(tm, e);
319     tm->entryCount++;
320     return (SgTreeEntry*)e;
321   }
322 }
323 
fix_after_deletion(SgTreeMap * tm,node_t * x)324 static void fix_after_deletion(SgTreeMap *tm, node_t *x)
325 {
326   while (x != NODE(tm->root) && COLOR_OF(x) == BLACK) {
327     if (x == LEFT_OF(PARENT_OF(x))) {
328       node_t *sib = RIGHT_OF(PARENT_OF(x));
329       if (COLOR_OF(sib) == RED) {
330 	SET_COLOR(sib, BLACK);
331 	SET_COLOR(PARENT_OF(x), RED);
332 	rotate_left(tm, PARENT_OF(x));
333 	sib = RIGHT_OF(PARENT_OF(x));
334       }
335 
336       if (COLOR_OF(LEFT_OF(sib))  == BLACK &&
337 	  COLOR_OF(RIGHT_OF(sib)) == BLACK) {
338 	x = PARENT_OF(x);
339       } else {
340 	if (COLOR_OF(RIGHT_OF(sib)) == BLACK) {
341 	  SET_COLOR(LEFT_OF(sib), BLACK);
342 	  SET_COLOR(sib, RED);
343 	  rotate_right(tm, sib);
344 	  sib = RIGHT_OF(PARENT_OF(x));
345 	}
346 	SET_COLOR(sib, COLOR_OF(PARENT_OF(x)));
347 	SET_COLOR(PARENT_OF(x), BLACK);
348 	SET_COLOR(RIGHT_OF(sib), BLACK);
349 	rotate_left(tm, PARENT_OF(x));
350 	x = (node_t*)tm->root;
351       }
352     } else {
353       node_t *sib = LEFT_OF(PARENT_OF(x));
354       if (COLOR_OF(sib) == RED) {
355 	SET_COLOR(sib, BLACK);
356 	SET_COLOR(PARENT_OF(x), RED);
357 	rotate_right(tm, PARENT_OF(x));
358 	sib = LEFT_OF(PARENT_OF(x));
359       }
360       if (COLOR_OF(RIGHT_OF(sib)) == BLACK &&
361 	  COLOR_OF(LEFT_OF(sib))  == BLACK) {
362 	SET_COLOR(sib, RED);
363 	x = PARENT_OF(x);
364       } else {
365 	if (COLOR_OF(LEFT_OF(sib)) == BLACK) {
366 	  SET_COLOR(RIGHT_OF(sib), BLACK);
367 	  SET_COLOR(sib, RED);
368 	  rotate_left(tm, sib);
369 	  sib = LEFT_OF(PARENT_OF(x));
370 	}
371 	SET_COLOR(sib, COLOR_OF(PARENT_OF(x)));
372 	SET_COLOR(PARENT_OF(x), BLACK);
373 	SET_COLOR(LEFT_OF(sib), BLACK);
374 	rotate_right(tm, PARENT_OF(x));
375 	x = (node_t*)tm->root;
376       }
377     }
378   }
379 }
380 
delete_entry(SgTreeMap * tm,node_t * p)381 static void delete_entry(SgTreeMap *tm, node_t *p)
382 {
383   node_t *replacement;
384   tm->entryCount--;
385   if (p->left != NULL && p->right != NULL) {
386     node_t *s = successor(p);
387     p->key = s->key;
388     p->value = s->value;
389     p = s;
390   }
391   replacement = (p->left) ? p->left : p->right;
392   if (replacement != NULL) {
393     replacement->parent = p->parent;
394     if (p->parent == NULL) tm->root = (intptr_t)replacement;
395     else if (p == p->parent->left) p->parent->left = replacement;
396     else p->parent->right = replacement;
397     p->left = p->right = p->parent = NULL;
398 
399     if (p->color == BLACK) {
400       fix_after_deletion(tm, replacement);
401     }
402   } else if (p->parent == NULL) {
403     tm->root = (intptr_t)NULL;
404   } else {
405     if (p->color == BLACK) {
406       fix_after_deletion(tm, p);
407     }
408     if (p->parent != NULL) {
409       if (p == p->parent->left) p->parent->left = NULL;
410       else if (p == p->parent->right) p->parent->right = NULL;
411       p->parent = NULL;
412     }
413   }
414 }
415 
rb_delete(SgTreeMap * tm,intptr_t key)416 static SgTreeEntry* rb_delete(SgTreeMap *tm, intptr_t key)
417 {
418   node_t *p = get_entry(tm, key);
419   if (p == NULL) return NULL;
420   delete_entry(tm, p);
421   return (SgTreeEntry *)p;
422 }
423 
copy_tree(node_t * parent,node_t * self)424 static node_t* copy_tree(node_t *parent, node_t *self)
425 {
426   node_t *n = new_node(self->key, parent);
427   n->value = self->value;
428   n->color = self->color;
429   if (self->left) n->left = copy_tree(n, self->left);
430   if (self->right) n->right = copy_tree(n, self->right);
431   return n;
432 }
433 
434 static SgObject rb_copy(const SgTreeMap *tm);
435 static SgTreeIter* rb_iter(SgTreeIter *iter, SgTreeMap *tm,
436 			   SgTreeEntry *start, int ascP);
437 
rb_search(SgTreeMap * tm,intptr_t key,SgDictOp op)438 static SgTreeEntry* rb_search(SgTreeMap *tm, intptr_t key, SgDictOp op)
439 {
440   switch (op) {
441   case SG_DICT_GET: return rb_ref(tm, key);
442   case SG_DICT_CREATE: return rb_set(tm, key);
443   case SG_DICT_DELETE: return rb_delete(tm, key);
444   }
445   Sg_Error(UC("[Internal] Operation is not supported."));
446   return NULL;
447 }
448 
rb_copy(const SgTreeMap * tm)449 static SgObject rb_copy(const SgTreeMap *tm)
450 {
451   SgTreeMap *dst = Sg_MakeGenericCTreeMap(SG_TREEMAP_C_PROC(tm, cmp),
452 					  rb_search,
453 					  rb_copy,
454 					  rb_iter,
455 					  rb_higher,
456 					  rb_lower,
457 					  tm->data);
458   if (tm->root) {
459     dst->root = (intptr_t)copy_tree(NULL, NODE(tm->root));
460   } else {
461     dst->root = (intptr_t)NULL;
462   }
463   dst->entryCount = tm->entryCount;
464   return dst;
465 }
466 
get_first_left_entry(SgTreeMap * tm)467 static node_t* get_first_left_entry(SgTreeMap *tm)
468 {
469   node_t *p = NODE(tm->root);
470   if (p != NULL)
471     while (p->left != NULL) p = p->left;
472   return p;
473 }
474 
get_first_right_entry(SgTreeMap * tm)475 static node_t* get_first_right_entry(SgTreeMap *tm)
476 {
477   node_t *p = NODE(tm->root);
478   if (p != NULL)
479     while (p->right != NULL) p = p->right;
480   return p;
481 }
482 
483 
rb_iter_next(SgTreeIter * iter)484 static SgTreeEntry *rb_iter_next(SgTreeIter *iter)
485 {
486   if (iter->end) return NULL;
487   if (iter->e) {
488     iter->e = (SgTreeEntry*)successor((node_t*)iter->e);
489   } else {
490     iter->e = (SgTreeEntry*)get_first_left_entry(iter->t);
491   }
492   if (iter->e == NULL) iter->end = TRUE;
493   return (SgTreeEntry*)iter->e;
494 }
495 
rb_iter_reverse_next(SgTreeIter * iter)496 static SgTreeEntry *rb_iter_reverse_next(SgTreeIter *iter)
497 {
498   if (iter->end) return NULL;
499   if (iter->e) {
500     iter->e = (SgTreeEntry*)predecessor((node_t*)iter->e);
501   } else {
502     iter->e = (SgTreeEntry*)get_first_right_entry(iter->t);
503   }
504   if (iter->e == NULL) iter->end = TRUE;
505   return (SgTreeEntry*)iter->e;
506 }
507 
508 
rb_iter(SgTreeIter * iter,SgTreeMap * tm,SgTreeEntry * start,int ascP)509 static SgTreeIter* rb_iter(SgTreeIter *iter, SgTreeMap *tm,
510 			   SgTreeEntry *start, int ascP)
511 {
512   if (start && get_entry(tm, start->key) != (node_t*)start) {
513     Sg_Error(UC("rb_iter: iteration start point is not a part of the tree."));
514   }
515   iter->next = (ascP)? rb_iter_next: rb_iter_reverse_next;
516   iter->t = tm;
517   iter->e = start;
518   iter->end = FALSE;
519   return iter;
520 }
521 
Sg_MakeRBTreeMap(SgTreeCompareProc * cmp)522 SgObject Sg_MakeRBTreeMap(SgTreeCompareProc *cmp)
523 {
524   return Sg_MakeGenericCTreeMap(cmp,
525 				rb_search,
526 				rb_copy,
527 				rb_iter,
528 				rb_higher,
529 				rb_lower,
530 				NULL);
531 }
532 
wrapped_compare(SgTreeMap * tm,intptr_t a,intptr_t b)533 static int wrapped_compare(SgTreeMap *tm, intptr_t a, intptr_t b)
534 {
535   SgObject r;
536   if (SG_SUBRP(tm->data)) {
537     SG_CALL_SUBR2(r, tm->data, SG_OBJ(a), SG_OBJ(b));
538   } else {
539     r = Sg_Apply2(SG_OBJ(tm->data), SG_OBJ(a), SG_OBJ(b));
540   }
541   if (SG_INTP(r)) {
542     long l = SG_INT_VALUE(r);
543     if (l == 0) return 0;
544     else if (l > 0) return 1;
545     else return -1;
546   }
547   Sg_Error(UC("compare returned non exact integer value %S"), r);
548   return 0; 			/* dummy */
549 }
550 
Sg_MakeSchemeRBTreeMap(SgObject cmp)551 SgObject Sg_MakeSchemeRBTreeMap(SgObject cmp)
552 {
553   return Sg_MakeGenericCTreeMap(wrapped_compare,
554 				rb_search,
555 				rb_copy,
556 				rb_iter,
557 				rb_higher,
558 				rb_lower,
559 				cmp);
560 }
561