gfortran.texi: Add link to GFortran apps
[gcc.git] / gcc / fortran / bbt.c
1 /* Balanced binary trees using treaps.
2 Copyright (C) 2000, 2002, 2003 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
4
5 This file is part of GCC.
6
7 GCC is free software; you can redistribute it and/or modify it under
8 the terms of the GNU General Public License as published by the Free
9 Software Foundation; either version 2, or (at your option) any later
10 version.
11
12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GCC; see the file COPYING. If not, write to the Free
19 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
20 02110-1301, USA. */
21
22 /* The idea is to balance the tree using pseudorandom numbers. The
23 main constraint on this implementation is that we have several
24 distinct structures that have to be arranged in a binary tree.
25 These structures all contain a BBT_HEADER() in front that gives the
26 treap-related information. The key and value are assumed to reside
27 in the rest of the structure.
28
29 When calling, we are also passed a comparison function that
30 compares two nodes. We don't implement a separate 'find' function
31 here, but rather use separate functions for each variety of tree.
32 We are also restricted to not copy treap structures, which most
33 implementations find convenient, because we otherwise would need to
34 know how long the structure is.
35
36 This implementation is based on Stefan Nilsson's article in the
37 July 1997 Doctor Dobb's Journal, "Treaps in Java". */
38
39 #include "config.h"
40 #include "gfortran.h"
41
42 typedef struct gfc_treap
43 {
44 BBT_HEADER (gfc_treap);
45 }
46 gfc_bbt;
47
48 /* Simple linear congruential pseudorandom number generator. The
49 period of this generator is 44071, which is plenty for our
50 purposes. */
51
52 static int
53 pseudo_random (void)
54 {
55 static int x0 = 5341;
56
57 x0 = (22611 * x0 + 10) % 44071;
58 return x0;
59 }
60
61
62 /* Rotate the treap left. */
63
64 static gfc_bbt *
65 rotate_left (gfc_bbt * t)
66 {
67 gfc_bbt *temp;
68
69 temp = t->right;
70 t->right = t->right->left;
71 temp->left = t;
72
73 return temp;
74 }
75
76
77 /* Rotate the treap right. */
78
79 static gfc_bbt *
80 rotate_right (gfc_bbt * t)
81 {
82 gfc_bbt *temp;
83
84 temp = t->left;
85 t->left = t->left->right;
86 temp->right = t;
87
88 return temp;
89 }
90
91
92 /* Recursive insertion function. Returns the updated treap, or
93 aborts if we find a duplicate key. */
94
95 static gfc_bbt *
96 insert (gfc_bbt * new, gfc_bbt * t, compare_fn compare)
97 {
98 int c;
99
100 if (t == NULL)
101 return new;
102
103 c = (*compare) (new, t);
104
105 if (c < 0)
106 {
107 t->left = insert (new, t->left, compare);
108 if (t->priority < t->left->priority)
109 t = rotate_right (t);
110 }
111
112 else if (c > 0)
113 {
114 t->right = insert (new, t->right, compare);
115 if (t->priority < t->right->priority)
116 t = rotate_left (t);
117 }
118
119 else /* if (c == 0) */
120 gfc_internal_error("insert_bbt(): Duplicate key found!");
121
122 return t;
123 }
124
125
126 /* Given root pointer, a new node and a comparison function, insert
127 the new node into the treap. It is an error to insert a key that
128 already exists. */
129
130 void
131 gfc_insert_bbt (void *root, void *new, compare_fn compare)
132 {
133 gfc_bbt **r, *n;
134
135 r = (gfc_bbt **) root;
136 n = (gfc_bbt *) new;
137
138 n->priority = pseudo_random ();
139 *r = insert (n, *r, compare);
140 }
141
142 static gfc_bbt *
143 delete_root (gfc_bbt * t)
144 {
145 gfc_bbt *temp;
146
147 if (t->left == NULL)
148 return t->right;
149 if (t->right == NULL)
150 return t->left;
151
152 if (t->left->priority > t->right->priority)
153 {
154 temp = rotate_right (t);
155 temp->right = delete_root (t);
156 }
157 else
158 {
159 temp = rotate_left (t);
160 temp->left = delete_root (t);
161 }
162
163 return temp;
164 }
165
166
167 /* Delete an element from a tree. The 'old' value does not
168 necessarily have to point to the element to be deleted, it must
169 just point to a treap structure with the key to be deleted.
170 Returns the new root node of the tree. */
171
172 static gfc_bbt *
173 delete_treap (gfc_bbt * old, gfc_bbt * t, compare_fn compare)
174 {
175 int c;
176
177 if (t == NULL)
178 return NULL;
179
180 c = (*compare) (old, t);
181
182 if (c < 0)
183 t->left = delete_treap (old, t->left, compare);
184 if (c > 0)
185 t->right = delete_treap (old, t->right, compare);
186 if (c == 0)
187 t = delete_root (t);
188
189 return t;
190 }
191
192
193 void
194 gfc_delete_bbt (void *root, void *old, compare_fn compare)
195 {
196 gfc_bbt **t;
197
198 t = (gfc_bbt **) root;
199
200 *t = delete_treap ((gfc_bbt *) old, *t, compare);
201 }