annotate gcc/ada/elists.adb @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT COMPILER COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- E L I S T S --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
kono
parents:
diff changeset
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
kono
parents:
diff changeset
17 -- --
kono
parents:
diff changeset
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
kono
parents:
diff changeset
19 -- additional permissions described in the GCC Runtime Library Exception, --
kono
parents:
diff changeset
20 -- version 3.1, as published by the Free Software Foundation. --
kono
parents:
diff changeset
21 -- --
kono
parents:
diff changeset
22 -- You should have received a copy of the GNU General Public License and --
kono
parents:
diff changeset
23 -- a copy of the GCC Runtime Library Exception along with this program; --
kono
parents:
diff changeset
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
kono
parents:
diff changeset
25 -- <http://www.gnu.org/licenses/>. --
kono
parents:
diff changeset
26 -- --
kono
parents:
diff changeset
27 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
29 -- --
kono
parents:
diff changeset
30 ------------------------------------------------------------------------------
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 -- WARNING: There is a C version of this package. Any changes to this
kono
parents:
diff changeset
33 -- source file must be properly reflected in the C header a-elists.h.
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 with Alloc;
kono
parents:
diff changeset
36 with Debug; use Debug;
kono
parents:
diff changeset
37 with Output; use Output;
kono
parents:
diff changeset
38 with Table;
kono
parents:
diff changeset
39
kono
parents:
diff changeset
40 package body Elists is
kono
parents:
diff changeset
41
kono
parents:
diff changeset
42 -------------------------------------
kono
parents:
diff changeset
43 -- Implementation of Element Lists --
kono
parents:
diff changeset
44 -------------------------------------
kono
parents:
diff changeset
45
kono
parents:
diff changeset
46 -- Element lists are composed of three types of entities. The element
kono
parents:
diff changeset
47 -- list header, which references the first and last elements of the
kono
parents:
diff changeset
48 -- list, the elements themselves which are singly linked and also
kono
parents:
diff changeset
49 -- reference the nodes on the list, and finally the nodes themselves.
kono
parents:
diff changeset
50 -- The following diagram shows how an element list is represented:
kono
parents:
diff changeset
51
kono
parents:
diff changeset
52 -- +----------------------------------------------------+
kono
parents:
diff changeset
53 -- | +------------------------------------------+ |
kono
parents:
diff changeset
54 -- | | | |
kono
parents:
diff changeset
55 -- V | V |
kono
parents:
diff changeset
56 -- +-----|--+ +-------+ +-------+ +-------+ |
kono
parents:
diff changeset
57 -- | Elmt | | 1st | | 2nd | | Last | |
kono
parents:
diff changeset
58 -- | List |--->| Elmt |--->| Elmt ---...-->| Elmt ---+
kono
parents:
diff changeset
59 -- | Header | | | | | | | | | |
kono
parents:
diff changeset
60 -- +--------+ +---|---+ +---|---+ +---|---+
kono
parents:
diff changeset
61 -- | | |
kono
parents:
diff changeset
62 -- V V V
kono
parents:
diff changeset
63 -- +-------+ +-------+ +-------+
kono
parents:
diff changeset
64 -- | | | | | |
kono
parents:
diff changeset
65 -- | Node1 | | Node2 | | Node3 |
kono
parents:
diff changeset
66 -- | | | | | |
kono
parents:
diff changeset
67 -- +-------+ +-------+ +-------+
kono
parents:
diff changeset
68
kono
parents:
diff changeset
69 -- The list header is an entry in the Elists table. The values used for
kono
parents:
diff changeset
70 -- the type Elist_Id are subscripts into this table. The First_Elmt field
kono
parents:
diff changeset
71 -- (Lfield1) points to the first element on the list, or to No_Elmt in the
kono
parents:
diff changeset
72 -- case of an empty list. Similarly the Last_Elmt field (Lfield2) points to
kono
parents:
diff changeset
73 -- the last element on the list or to No_Elmt in the case of an empty list.
kono
parents:
diff changeset
74
kono
parents:
diff changeset
75 -- The elements themselves are entries in the Elmts table. The Next field
kono
parents:
diff changeset
76 -- of each entry points to the next element, or to the Elist header if this
kono
parents:
diff changeset
77 -- is the last item in the list. The Node field points to the node which
kono
parents:
diff changeset
78 -- is referenced by the corresponding list entry.
kono
parents:
diff changeset
79
kono
parents:
diff changeset
80 -------------------------
kono
parents:
diff changeset
81 -- Element List Tables --
kono
parents:
diff changeset
82 -------------------------
kono
parents:
diff changeset
83
kono
parents:
diff changeset
84 type Elist_Header is record
kono
parents:
diff changeset
85 First : Elmt_Id;
kono
parents:
diff changeset
86 Last : Elmt_Id;
kono
parents:
diff changeset
87 end record;
kono
parents:
diff changeset
88
kono
parents:
diff changeset
89 package Elists is new Table.Table (
kono
parents:
diff changeset
90 Table_Component_Type => Elist_Header,
kono
parents:
diff changeset
91 Table_Index_Type => Elist_Id'Base,
kono
parents:
diff changeset
92 Table_Low_Bound => First_Elist_Id,
kono
parents:
diff changeset
93 Table_Initial => Alloc.Elists_Initial,
kono
parents:
diff changeset
94 Table_Increment => Alloc.Elists_Increment,
kono
parents:
diff changeset
95 Table_Name => "Elists");
kono
parents:
diff changeset
96
kono
parents:
diff changeset
97 type Elmt_Item is record
kono
parents:
diff changeset
98 Node : Node_Or_Entity_Id;
kono
parents:
diff changeset
99 Next : Union_Id;
kono
parents:
diff changeset
100 end record;
kono
parents:
diff changeset
101
kono
parents:
diff changeset
102 package Elmts is new Table.Table (
kono
parents:
diff changeset
103 Table_Component_Type => Elmt_Item,
kono
parents:
diff changeset
104 Table_Index_Type => Elmt_Id'Base,
kono
parents:
diff changeset
105 Table_Low_Bound => First_Elmt_Id,
kono
parents:
diff changeset
106 Table_Initial => Alloc.Elmts_Initial,
kono
parents:
diff changeset
107 Table_Increment => Alloc.Elmts_Increment,
kono
parents:
diff changeset
108 Table_Name => "Elmts");
kono
parents:
diff changeset
109
kono
parents:
diff changeset
110 -----------------
kono
parents:
diff changeset
111 -- Append_Elmt --
kono
parents:
diff changeset
112 -----------------
kono
parents:
diff changeset
113
kono
parents:
diff changeset
114 procedure Append_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
kono
parents:
diff changeset
115 L : constant Elmt_Id := Elists.Table (To).Last;
kono
parents:
diff changeset
116
kono
parents:
diff changeset
117 begin
kono
parents:
diff changeset
118 Elmts.Increment_Last;
kono
parents:
diff changeset
119 Elmts.Table (Elmts.Last).Node := N;
kono
parents:
diff changeset
120 Elmts.Table (Elmts.Last).Next := Union_Id (To);
kono
parents:
diff changeset
121
kono
parents:
diff changeset
122 if L = No_Elmt then
kono
parents:
diff changeset
123 Elists.Table (To).First := Elmts.Last;
kono
parents:
diff changeset
124 else
kono
parents:
diff changeset
125 Elmts.Table (L).Next := Union_Id (Elmts.Last);
kono
parents:
diff changeset
126 end if;
kono
parents:
diff changeset
127
kono
parents:
diff changeset
128 Elists.Table (To).Last := Elmts.Last;
kono
parents:
diff changeset
129
kono
parents:
diff changeset
130 if Debug_Flag_N then
kono
parents:
diff changeset
131 Write_Str ("Append new element Elmt_Id = ");
kono
parents:
diff changeset
132 Write_Int (Int (Elmts.Last));
kono
parents:
diff changeset
133 Write_Str (" to list Elist_Id = ");
kono
parents:
diff changeset
134 Write_Int (Int (To));
kono
parents:
diff changeset
135 Write_Str (" referencing Node_Or_Entity_Id = ");
kono
parents:
diff changeset
136 Write_Int (Int (N));
kono
parents:
diff changeset
137 Write_Eol;
kono
parents:
diff changeset
138 end if;
kono
parents:
diff changeset
139 end Append_Elmt;
kono
parents:
diff changeset
140
kono
parents:
diff changeset
141 ---------------------
kono
parents:
diff changeset
142 -- Append_New_Elmt --
kono
parents:
diff changeset
143 ---------------------
kono
parents:
diff changeset
144
kono
parents:
diff changeset
145 procedure Append_New_Elmt (N : Node_Or_Entity_Id; To : in out Elist_Id) is
kono
parents:
diff changeset
146 begin
kono
parents:
diff changeset
147 if To = No_Elist then
kono
parents:
diff changeset
148 To := New_Elmt_List;
kono
parents:
diff changeset
149 end if;
kono
parents:
diff changeset
150
kono
parents:
diff changeset
151 Append_Elmt (N, To);
kono
parents:
diff changeset
152 end Append_New_Elmt;
kono
parents:
diff changeset
153
kono
parents:
diff changeset
154 ------------------------
kono
parents:
diff changeset
155 -- Append_Unique_Elmt --
kono
parents:
diff changeset
156 ------------------------
kono
parents:
diff changeset
157
kono
parents:
diff changeset
158 procedure Append_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
kono
parents:
diff changeset
159 Elmt : Elmt_Id;
kono
parents:
diff changeset
160 begin
kono
parents:
diff changeset
161 Elmt := First_Elmt (To);
kono
parents:
diff changeset
162 loop
kono
parents:
diff changeset
163 if No (Elmt) then
kono
parents:
diff changeset
164 Append_Elmt (N, To);
kono
parents:
diff changeset
165 return;
kono
parents:
diff changeset
166 elsif Node (Elmt) = N then
kono
parents:
diff changeset
167 return;
kono
parents:
diff changeset
168 else
kono
parents:
diff changeset
169 Next_Elmt (Elmt);
kono
parents:
diff changeset
170 end if;
kono
parents:
diff changeset
171 end loop;
kono
parents:
diff changeset
172 end Append_Unique_Elmt;
kono
parents:
diff changeset
173
kono
parents:
diff changeset
174 --------------
kono
parents:
diff changeset
175 -- Contains --
kono
parents:
diff changeset
176 --------------
kono
parents:
diff changeset
177
kono
parents:
diff changeset
178 function Contains (List : Elist_Id; N : Node_Or_Entity_Id) return Boolean is
kono
parents:
diff changeset
179 Elmt : Elmt_Id;
kono
parents:
diff changeset
180
kono
parents:
diff changeset
181 begin
kono
parents:
diff changeset
182 if Present (List) then
kono
parents:
diff changeset
183 Elmt := First_Elmt (List);
kono
parents:
diff changeset
184 while Present (Elmt) loop
kono
parents:
diff changeset
185 if Node (Elmt) = N then
kono
parents:
diff changeset
186 return True;
kono
parents:
diff changeset
187 end if;
kono
parents:
diff changeset
188
kono
parents:
diff changeset
189 Next_Elmt (Elmt);
kono
parents:
diff changeset
190 end loop;
kono
parents:
diff changeset
191 end if;
kono
parents:
diff changeset
192
kono
parents:
diff changeset
193 return False;
kono
parents:
diff changeset
194 end Contains;
kono
parents:
diff changeset
195
kono
parents:
diff changeset
196 --------------------
kono
parents:
diff changeset
197 -- Elists_Address --
kono
parents:
diff changeset
198 --------------------
kono
parents:
diff changeset
199
kono
parents:
diff changeset
200 function Elists_Address return System.Address is
kono
parents:
diff changeset
201 begin
kono
parents:
diff changeset
202 return Elists.Table (First_Elist_Id)'Address;
kono
parents:
diff changeset
203 end Elists_Address;
kono
parents:
diff changeset
204
kono
parents:
diff changeset
205 -------------------
kono
parents:
diff changeset
206 -- Elmts_Address --
kono
parents:
diff changeset
207 -------------------
kono
parents:
diff changeset
208
kono
parents:
diff changeset
209 function Elmts_Address return System.Address is
kono
parents:
diff changeset
210 begin
kono
parents:
diff changeset
211 return Elmts.Table (First_Elmt_Id)'Address;
kono
parents:
diff changeset
212 end Elmts_Address;
kono
parents:
diff changeset
213
kono
parents:
diff changeset
214 ----------------
kono
parents:
diff changeset
215 -- First_Elmt --
kono
parents:
diff changeset
216 ----------------
kono
parents:
diff changeset
217
kono
parents:
diff changeset
218 function First_Elmt (List : Elist_Id) return Elmt_Id is
kono
parents:
diff changeset
219 begin
kono
parents:
diff changeset
220 pragma Assert (List > Elist_Low_Bound);
kono
parents:
diff changeset
221 return Elists.Table (List).First;
kono
parents:
diff changeset
222 end First_Elmt;
kono
parents:
diff changeset
223
kono
parents:
diff changeset
224 ----------------
kono
parents:
diff changeset
225 -- Initialize --
kono
parents:
diff changeset
226 ----------------
kono
parents:
diff changeset
227
kono
parents:
diff changeset
228 procedure Initialize is
kono
parents:
diff changeset
229 begin
kono
parents:
diff changeset
230 Elists.Init;
kono
parents:
diff changeset
231 Elmts.Init;
kono
parents:
diff changeset
232 end Initialize;
kono
parents:
diff changeset
233
kono
parents:
diff changeset
234 -----------------------
kono
parents:
diff changeset
235 -- Insert_Elmt_After --
kono
parents:
diff changeset
236 -----------------------
kono
parents:
diff changeset
237
kono
parents:
diff changeset
238 procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id) is
kono
parents:
diff changeset
239 Nxt : constant Union_Id := Elmts.Table (Elmt).Next;
kono
parents:
diff changeset
240
kono
parents:
diff changeset
241 begin
kono
parents:
diff changeset
242 pragma Assert (Elmt /= No_Elmt);
kono
parents:
diff changeset
243
kono
parents:
diff changeset
244 Elmts.Increment_Last;
kono
parents:
diff changeset
245 Elmts.Table (Elmts.Last).Node := N;
kono
parents:
diff changeset
246 Elmts.Table (Elmts.Last).Next := Nxt;
kono
parents:
diff changeset
247
kono
parents:
diff changeset
248 Elmts.Table (Elmt).Next := Union_Id (Elmts.Last);
kono
parents:
diff changeset
249
kono
parents:
diff changeset
250 if Nxt in Elist_Range then
kono
parents:
diff changeset
251 Elists.Table (Elist_Id (Nxt)).Last := Elmts.Last;
kono
parents:
diff changeset
252 end if;
kono
parents:
diff changeset
253 end Insert_Elmt_After;
kono
parents:
diff changeset
254
kono
parents:
diff changeset
255 ------------------------
kono
parents:
diff changeset
256 -- Is_Empty_Elmt_List --
kono
parents:
diff changeset
257 ------------------------
kono
parents:
diff changeset
258
kono
parents:
diff changeset
259 function Is_Empty_Elmt_List (List : Elist_Id) return Boolean is
kono
parents:
diff changeset
260 begin
kono
parents:
diff changeset
261 return Elists.Table (List).First = No_Elmt;
kono
parents:
diff changeset
262 end Is_Empty_Elmt_List;
kono
parents:
diff changeset
263
kono
parents:
diff changeset
264 -------------------
kono
parents:
diff changeset
265 -- Last_Elist_Id --
kono
parents:
diff changeset
266 -------------------
kono
parents:
diff changeset
267
kono
parents:
diff changeset
268 function Last_Elist_Id return Elist_Id is
kono
parents:
diff changeset
269 begin
kono
parents:
diff changeset
270 return Elists.Last;
kono
parents:
diff changeset
271 end Last_Elist_Id;
kono
parents:
diff changeset
272
kono
parents:
diff changeset
273 ---------------
kono
parents:
diff changeset
274 -- Last_Elmt --
kono
parents:
diff changeset
275 ---------------
kono
parents:
diff changeset
276
kono
parents:
diff changeset
277 function Last_Elmt (List : Elist_Id) return Elmt_Id is
kono
parents:
diff changeset
278 begin
kono
parents:
diff changeset
279 return Elists.Table (List).Last;
kono
parents:
diff changeset
280 end Last_Elmt;
kono
parents:
diff changeset
281
kono
parents:
diff changeset
282 ------------------
kono
parents:
diff changeset
283 -- Last_Elmt_Id --
kono
parents:
diff changeset
284 ------------------
kono
parents:
diff changeset
285
kono
parents:
diff changeset
286 function Last_Elmt_Id return Elmt_Id is
kono
parents:
diff changeset
287 begin
kono
parents:
diff changeset
288 return Elmts.Last;
kono
parents:
diff changeset
289 end Last_Elmt_Id;
kono
parents:
diff changeset
290
kono
parents:
diff changeset
291 -----------------
kono
parents:
diff changeset
292 -- List_Length --
kono
parents:
diff changeset
293 -----------------
kono
parents:
diff changeset
294
kono
parents:
diff changeset
295 function List_Length (List : Elist_Id) return Nat is
kono
parents:
diff changeset
296 Elmt : Elmt_Id;
kono
parents:
diff changeset
297 N : Nat;
kono
parents:
diff changeset
298
kono
parents:
diff changeset
299 begin
kono
parents:
diff changeset
300 if List = No_Elist then
kono
parents:
diff changeset
301 return 0;
kono
parents:
diff changeset
302
kono
parents:
diff changeset
303 else
kono
parents:
diff changeset
304 N := 0;
kono
parents:
diff changeset
305 Elmt := First_Elmt (List);
kono
parents:
diff changeset
306 loop
kono
parents:
diff changeset
307 if No (Elmt) then
kono
parents:
diff changeset
308 return N;
kono
parents:
diff changeset
309 else
kono
parents:
diff changeset
310 N := N + 1;
kono
parents:
diff changeset
311 Next_Elmt (Elmt);
kono
parents:
diff changeset
312 end if;
kono
parents:
diff changeset
313 end loop;
kono
parents:
diff changeset
314 end if;
kono
parents:
diff changeset
315 end List_Length;
kono
parents:
diff changeset
316
kono
parents:
diff changeset
317 ----------
kono
parents:
diff changeset
318 -- Lock --
kono
parents:
diff changeset
319 ----------
kono
parents:
diff changeset
320
kono
parents:
diff changeset
321 procedure Lock is
kono
parents:
diff changeset
322 begin
kono
parents:
diff changeset
323 Elists.Release;
kono
parents:
diff changeset
324 Elists.Locked := True;
kono
parents:
diff changeset
325 Elmts.Release;
kono
parents:
diff changeset
326 Elmts.Locked := True;
kono
parents:
diff changeset
327 end Lock;
kono
parents:
diff changeset
328
kono
parents:
diff changeset
329 --------------------
kono
parents:
diff changeset
330 -- New_Copy_Elist --
kono
parents:
diff changeset
331 --------------------
kono
parents:
diff changeset
332
kono
parents:
diff changeset
333 function New_Copy_Elist (List : Elist_Id) return Elist_Id is
kono
parents:
diff changeset
334 Result : Elist_Id;
kono
parents:
diff changeset
335 Elmt : Elmt_Id;
kono
parents:
diff changeset
336
kono
parents:
diff changeset
337 begin
kono
parents:
diff changeset
338 if List = No_Elist then
kono
parents:
diff changeset
339 return No_Elist;
kono
parents:
diff changeset
340
kono
parents:
diff changeset
341 -- Replicate the contents of the input list while preserving the
kono
parents:
diff changeset
342 -- original order.
kono
parents:
diff changeset
343
kono
parents:
diff changeset
344 else
kono
parents:
diff changeset
345 Result := New_Elmt_List;
kono
parents:
diff changeset
346
kono
parents:
diff changeset
347 Elmt := First_Elmt (List);
kono
parents:
diff changeset
348 while Present (Elmt) loop
kono
parents:
diff changeset
349 Append_Elmt (Node (Elmt), Result);
kono
parents:
diff changeset
350 Next_Elmt (Elmt);
kono
parents:
diff changeset
351 end loop;
kono
parents:
diff changeset
352
kono
parents:
diff changeset
353 return Result;
kono
parents:
diff changeset
354 end if;
kono
parents:
diff changeset
355 end New_Copy_Elist;
kono
parents:
diff changeset
356
kono
parents:
diff changeset
357 -------------------
kono
parents:
diff changeset
358 -- New_Elmt_List --
kono
parents:
diff changeset
359 -------------------
kono
parents:
diff changeset
360
kono
parents:
diff changeset
361 function New_Elmt_List return Elist_Id is
kono
parents:
diff changeset
362 begin
kono
parents:
diff changeset
363 Elists.Increment_Last;
kono
parents:
diff changeset
364 Elists.Table (Elists.Last).First := No_Elmt;
kono
parents:
diff changeset
365 Elists.Table (Elists.Last).Last := No_Elmt;
kono
parents:
diff changeset
366
kono
parents:
diff changeset
367 if Debug_Flag_N then
kono
parents:
diff changeset
368 Write_Str ("Allocate new element list, returned ID = ");
kono
parents:
diff changeset
369 Write_Int (Int (Elists.Last));
kono
parents:
diff changeset
370 Write_Eol;
kono
parents:
diff changeset
371 end if;
kono
parents:
diff changeset
372
kono
parents:
diff changeset
373 return Elists.Last;
kono
parents:
diff changeset
374 end New_Elmt_List;
kono
parents:
diff changeset
375
kono
parents:
diff changeset
376 ---------------
kono
parents:
diff changeset
377 -- Next_Elmt --
kono
parents:
diff changeset
378 ---------------
kono
parents:
diff changeset
379
kono
parents:
diff changeset
380 function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id is
kono
parents:
diff changeset
381 N : constant Union_Id := Elmts.Table (Elmt).Next;
kono
parents:
diff changeset
382
kono
parents:
diff changeset
383 begin
kono
parents:
diff changeset
384 if N in Elist_Range then
kono
parents:
diff changeset
385 return No_Elmt;
kono
parents:
diff changeset
386 else
kono
parents:
diff changeset
387 return Elmt_Id (N);
kono
parents:
diff changeset
388 end if;
kono
parents:
diff changeset
389 end Next_Elmt;
kono
parents:
diff changeset
390
kono
parents:
diff changeset
391 procedure Next_Elmt (Elmt : in out Elmt_Id) is
kono
parents:
diff changeset
392 begin
kono
parents:
diff changeset
393 Elmt := Next_Elmt (Elmt);
kono
parents:
diff changeset
394 end Next_Elmt;
kono
parents:
diff changeset
395
kono
parents:
diff changeset
396 --------
kono
parents:
diff changeset
397 -- No --
kono
parents:
diff changeset
398 --------
kono
parents:
diff changeset
399
kono
parents:
diff changeset
400 function No (List : Elist_Id) return Boolean is
kono
parents:
diff changeset
401 begin
kono
parents:
diff changeset
402 return List = No_Elist;
kono
parents:
diff changeset
403 end No;
kono
parents:
diff changeset
404
kono
parents:
diff changeset
405 function No (Elmt : Elmt_Id) return Boolean is
kono
parents:
diff changeset
406 begin
kono
parents:
diff changeset
407 return Elmt = No_Elmt;
kono
parents:
diff changeset
408 end No;
kono
parents:
diff changeset
409
kono
parents:
diff changeset
410 ----------
kono
parents:
diff changeset
411 -- Node --
kono
parents:
diff changeset
412 ----------
kono
parents:
diff changeset
413
kono
parents:
diff changeset
414 function Node (Elmt : Elmt_Id) return Node_Or_Entity_Id is
kono
parents:
diff changeset
415 begin
kono
parents:
diff changeset
416 if Elmt = No_Elmt then
kono
parents:
diff changeset
417 return Empty;
kono
parents:
diff changeset
418 else
kono
parents:
diff changeset
419 return Elmts.Table (Elmt).Node;
kono
parents:
diff changeset
420 end if;
kono
parents:
diff changeset
421 end Node;
kono
parents:
diff changeset
422
kono
parents:
diff changeset
423 ----------------
kono
parents:
diff changeset
424 -- Num_Elists --
kono
parents:
diff changeset
425 ----------------
kono
parents:
diff changeset
426
kono
parents:
diff changeset
427 function Num_Elists return Nat is
kono
parents:
diff changeset
428 begin
kono
parents:
diff changeset
429 return Int (Elmts.Last) - Int (Elmts.First) + 1;
kono
parents:
diff changeset
430 end Num_Elists;
kono
parents:
diff changeset
431
kono
parents:
diff changeset
432 ------------------
kono
parents:
diff changeset
433 -- Prepend_Elmt --
kono
parents:
diff changeset
434 ------------------
kono
parents:
diff changeset
435
kono
parents:
diff changeset
436 procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
kono
parents:
diff changeset
437 F : constant Elmt_Id := Elists.Table (To).First;
kono
parents:
diff changeset
438
kono
parents:
diff changeset
439 begin
kono
parents:
diff changeset
440 Elmts.Increment_Last;
kono
parents:
diff changeset
441 Elmts.Table (Elmts.Last).Node := N;
kono
parents:
diff changeset
442
kono
parents:
diff changeset
443 if F = No_Elmt then
kono
parents:
diff changeset
444 Elists.Table (To).Last := Elmts.Last;
kono
parents:
diff changeset
445 Elmts.Table (Elmts.Last).Next := Union_Id (To);
kono
parents:
diff changeset
446 else
kono
parents:
diff changeset
447 Elmts.Table (Elmts.Last).Next := Union_Id (F);
kono
parents:
diff changeset
448 end if;
kono
parents:
diff changeset
449
kono
parents:
diff changeset
450 Elists.Table (To).First := Elmts.Last;
kono
parents:
diff changeset
451 end Prepend_Elmt;
kono
parents:
diff changeset
452
kono
parents:
diff changeset
453 -------------------------
kono
parents:
diff changeset
454 -- Prepend_Unique_Elmt --
kono
parents:
diff changeset
455 -------------------------
kono
parents:
diff changeset
456
kono
parents:
diff changeset
457 procedure Prepend_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
kono
parents:
diff changeset
458 begin
kono
parents:
diff changeset
459 if not Contains (To, N) then
kono
parents:
diff changeset
460 Prepend_Elmt (N, To);
kono
parents:
diff changeset
461 end if;
kono
parents:
diff changeset
462 end Prepend_Unique_Elmt;
kono
parents:
diff changeset
463
kono
parents:
diff changeset
464 -------------
kono
parents:
diff changeset
465 -- Present --
kono
parents:
diff changeset
466 -------------
kono
parents:
diff changeset
467
kono
parents:
diff changeset
468 function Present (List : Elist_Id) return Boolean is
kono
parents:
diff changeset
469 begin
kono
parents:
diff changeset
470 return List /= No_Elist;
kono
parents:
diff changeset
471 end Present;
kono
parents:
diff changeset
472
kono
parents:
diff changeset
473 function Present (Elmt : Elmt_Id) return Boolean is
kono
parents:
diff changeset
474 begin
kono
parents:
diff changeset
475 return Elmt /= No_Elmt;
kono
parents:
diff changeset
476 end Present;
kono
parents:
diff changeset
477
kono
parents:
diff changeset
478 ------------
kono
parents:
diff changeset
479 -- Remove --
kono
parents:
diff changeset
480 ------------
kono
parents:
diff changeset
481
kono
parents:
diff changeset
482 procedure Remove (List : Elist_Id; N : Node_Or_Entity_Id) is
kono
parents:
diff changeset
483 Elmt : Elmt_Id;
kono
parents:
diff changeset
484
kono
parents:
diff changeset
485 begin
kono
parents:
diff changeset
486 if Present (List) then
kono
parents:
diff changeset
487 Elmt := First_Elmt (List);
kono
parents:
diff changeset
488 while Present (Elmt) loop
kono
parents:
diff changeset
489 if Node (Elmt) = N then
kono
parents:
diff changeset
490 Remove_Elmt (List, Elmt);
kono
parents:
diff changeset
491 exit;
kono
parents:
diff changeset
492 end if;
kono
parents:
diff changeset
493
kono
parents:
diff changeset
494 Next_Elmt (Elmt);
kono
parents:
diff changeset
495 end loop;
kono
parents:
diff changeset
496 end if;
kono
parents:
diff changeset
497 end Remove;
kono
parents:
diff changeset
498
kono
parents:
diff changeset
499 -----------------
kono
parents:
diff changeset
500 -- Remove_Elmt --
kono
parents:
diff changeset
501 -----------------
kono
parents:
diff changeset
502
kono
parents:
diff changeset
503 procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id) is
kono
parents:
diff changeset
504 Nxt : Elmt_Id;
kono
parents:
diff changeset
505 Prv : Elmt_Id;
kono
parents:
diff changeset
506
kono
parents:
diff changeset
507 begin
kono
parents:
diff changeset
508 Nxt := Elists.Table (List).First;
kono
parents:
diff changeset
509
kono
parents:
diff changeset
510 -- Case of removing only element in the list
kono
parents:
diff changeset
511
kono
parents:
diff changeset
512 if Elmts.Table (Nxt).Next in Elist_Range then
kono
parents:
diff changeset
513 pragma Assert (Nxt = Elmt);
kono
parents:
diff changeset
514
kono
parents:
diff changeset
515 Elists.Table (List).First := No_Elmt;
kono
parents:
diff changeset
516 Elists.Table (List).Last := No_Elmt;
kono
parents:
diff changeset
517
kono
parents:
diff changeset
518 -- Case of removing the first element in the list
kono
parents:
diff changeset
519
kono
parents:
diff changeset
520 elsif Nxt = Elmt then
kono
parents:
diff changeset
521 Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next);
kono
parents:
diff changeset
522
kono
parents:
diff changeset
523 -- Case of removing second or later element in the list
kono
parents:
diff changeset
524
kono
parents:
diff changeset
525 else
kono
parents:
diff changeset
526 loop
kono
parents:
diff changeset
527 Prv := Nxt;
kono
parents:
diff changeset
528 Nxt := Elmt_Id (Elmts.Table (Prv).Next);
kono
parents:
diff changeset
529 exit when Nxt = Elmt
kono
parents:
diff changeset
530 or else Elmts.Table (Nxt).Next in Elist_Range;
kono
parents:
diff changeset
531 end loop;
kono
parents:
diff changeset
532
kono
parents:
diff changeset
533 pragma Assert (Nxt = Elmt);
kono
parents:
diff changeset
534
kono
parents:
diff changeset
535 Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next;
kono
parents:
diff changeset
536
kono
parents:
diff changeset
537 if Elmts.Table (Prv).Next in Elist_Range then
kono
parents:
diff changeset
538 Elists.Table (List).Last := Prv;
kono
parents:
diff changeset
539 end if;
kono
parents:
diff changeset
540 end if;
kono
parents:
diff changeset
541 end Remove_Elmt;
kono
parents:
diff changeset
542
kono
parents:
diff changeset
543 ----------------------
kono
parents:
diff changeset
544 -- Remove_Last_Elmt --
kono
parents:
diff changeset
545 ----------------------
kono
parents:
diff changeset
546
kono
parents:
diff changeset
547 procedure Remove_Last_Elmt (List : Elist_Id) is
kono
parents:
diff changeset
548 Nxt : Elmt_Id;
kono
parents:
diff changeset
549 Prv : Elmt_Id;
kono
parents:
diff changeset
550
kono
parents:
diff changeset
551 begin
kono
parents:
diff changeset
552 Nxt := Elists.Table (List).First;
kono
parents:
diff changeset
553
kono
parents:
diff changeset
554 -- Case of removing only element in the list
kono
parents:
diff changeset
555
kono
parents:
diff changeset
556 if Elmts.Table (Nxt).Next in Elist_Range then
kono
parents:
diff changeset
557 Elists.Table (List).First := No_Elmt;
kono
parents:
diff changeset
558 Elists.Table (List).Last := No_Elmt;
kono
parents:
diff changeset
559
kono
parents:
diff changeset
560 -- Case of at least two elements in list
kono
parents:
diff changeset
561
kono
parents:
diff changeset
562 else
kono
parents:
diff changeset
563 loop
kono
parents:
diff changeset
564 Prv := Nxt;
kono
parents:
diff changeset
565 Nxt := Elmt_Id (Elmts.Table (Prv).Next);
kono
parents:
diff changeset
566 exit when Elmts.Table (Nxt).Next in Elist_Range;
kono
parents:
diff changeset
567 end loop;
kono
parents:
diff changeset
568
kono
parents:
diff changeset
569 Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next;
kono
parents:
diff changeset
570 Elists.Table (List).Last := Prv;
kono
parents:
diff changeset
571 end if;
kono
parents:
diff changeset
572 end Remove_Last_Elmt;
kono
parents:
diff changeset
573
kono
parents:
diff changeset
574 ------------------
kono
parents:
diff changeset
575 -- Replace_Elmt --
kono
parents:
diff changeset
576 ------------------
kono
parents:
diff changeset
577
kono
parents:
diff changeset
578 procedure Replace_Elmt (Elmt : Elmt_Id; New_Node : Node_Or_Entity_Id) is
kono
parents:
diff changeset
579 begin
kono
parents:
diff changeset
580 Elmts.Table (Elmt).Node := New_Node;
kono
parents:
diff changeset
581 end Replace_Elmt;
kono
parents:
diff changeset
582
kono
parents:
diff changeset
583 ---------------
kono
parents:
diff changeset
584 -- Tree_Read --
kono
parents:
diff changeset
585 ---------------
kono
parents:
diff changeset
586
kono
parents:
diff changeset
587 procedure Tree_Read is
kono
parents:
diff changeset
588 begin
kono
parents:
diff changeset
589 Elists.Tree_Read;
kono
parents:
diff changeset
590 Elmts.Tree_Read;
kono
parents:
diff changeset
591 end Tree_Read;
kono
parents:
diff changeset
592
kono
parents:
diff changeset
593 ----------------
kono
parents:
diff changeset
594 -- Tree_Write --
kono
parents:
diff changeset
595 ----------------
kono
parents:
diff changeset
596
kono
parents:
diff changeset
597 procedure Tree_Write is
kono
parents:
diff changeset
598 begin
kono
parents:
diff changeset
599 Elists.Tree_Write;
kono
parents:
diff changeset
600 Elmts.Tree_Write;
kono
parents:
diff changeset
601 end Tree_Write;
kono
parents:
diff changeset
602
kono
parents:
diff changeset
603 ------------
kono
parents:
diff changeset
604 -- Unlock --
kono
parents:
diff changeset
605 ------------
kono
parents:
diff changeset
606
kono
parents:
diff changeset
607 procedure Unlock is
kono
parents:
diff changeset
608 begin
kono
parents:
diff changeset
609 Elists.Locked := False;
kono
parents:
diff changeset
610 Elmts.Locked := False;
kono
parents:
diff changeset
611 end Unlock;
kono
parents:
diff changeset
612
kono
parents:
diff changeset
613 end Elists;