]>
Commit | Line | Data |
---|---|---|
4c2d6a70 AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT LIBRARY COMPONENTS -- | |
4 | -- -- | |
15f6d6e7 | 5 | -- ADA.CONTAINERS.INDEFINITE_DOUBLY_LINKED_LISTS -- |
4c2d6a70 AC |
6 | -- -- |
7 | -- B o d y -- | |
8 | -- -- | |
748086b7 | 9 | -- Copyright (C) 2004-2009, Free Software Foundation, Inc. -- |
4c2d6a70 | 10 | -- -- |
4c2d6a70 AC |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
4c2d6a70 AC |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
748086b7 JJ |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 | -- version 3.1, as published by the Free Software Foundation. -- | |
21 | -- -- | |
22 | -- You should have received a copy of the GNU General Public License and -- | |
23 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 | -- <http://www.gnu.org/licenses/>. -- | |
4c2d6a70 AC |
26 | -- -- |
27 | -- This unit was originally developed by Matthew J Heaney. -- | |
28 | ------------------------------------------------------------------------------ | |
29 | ||
30 | with System; use type System.Address; | |
31 | with Ada.Unchecked_Deallocation; | |
32 | ||
33 | package body Ada.Containers.Indefinite_Doubly_Linked_Lists is | |
34 | ||
4c2d6a70 AC |
35 | procedure Free is |
36 | new Ada.Unchecked_Deallocation (Element_Type, Element_Access); | |
37 | ||
38 | ----------------------- | |
39 | -- Local Subprograms -- | |
40 | ----------------------- | |
41 | ||
ba355842 MH |
42 | procedure Free (X : in out Node_Access); |
43 | ||
4c2d6a70 AC |
44 | procedure Insert_Internal |
45 | (Container : in out List; | |
46 | Before : Node_Access; | |
47 | New_Node : Node_Access); | |
48 | ||
ba355842 MH |
49 | function Vet (Position : Cursor) return Boolean; |
50 | ||
4c2d6a70 AC |
51 | --------- |
52 | -- "=" -- | |
53 | --------- | |
54 | ||
55 | function "=" (Left, Right : List) return Boolean is | |
56 | L : Node_Access; | |
57 | R : Node_Access; | |
58 | ||
59 | begin | |
60 | if Left'Address = Right'Address then | |
61 | return True; | |
62 | end if; | |
63 | ||
64 | if Left.Length /= Right.Length then | |
65 | return False; | |
66 | end if; | |
67 | ||
68 | L := Left.First; | |
69 | R := Right.First; | |
70 | for J in 1 .. Left.Length loop | |
8704d4b3 | 71 | if L.Element.all /= R.Element.all then |
4c2d6a70 AC |
72 | return False; |
73 | end if; | |
74 | ||
75 | L := L.Next; | |
76 | R := R.Next; | |
77 | end loop; | |
78 | ||
79 | return True; | |
80 | end "="; | |
81 | ||
82 | ------------ | |
83 | -- Adjust -- | |
84 | ------------ | |
85 | ||
86 | procedure Adjust (Container : in out List) is | |
87 | Src : Node_Access := Container.First; | |
88 | Dst : Node_Access; | |
89 | ||
90 | begin | |
91 | if Src = null then | |
92 | pragma Assert (Container.Last = null); | |
93 | pragma Assert (Container.Length = 0); | |
8704d4b3 MH |
94 | pragma Assert (Container.Busy = 0); |
95 | pragma Assert (Container.Lock = 0); | |
4c2d6a70 AC |
96 | return; |
97 | end if; | |
98 | ||
99 | pragma Assert (Container.First.Prev = null); | |
100 | pragma Assert (Container.Last.Next = null); | |
101 | pragma Assert (Container.Length > 0); | |
102 | ||
103 | Container.First := null; | |
104 | Container.Last := null; | |
105 | Container.Length := 0; | |
8704d4b3 MH |
106 | Container.Busy := 0; |
107 | Container.Lock := 0; | |
4c2d6a70 | 108 | |
8704d4b3 MH |
109 | declare |
110 | Element : Element_Access := new Element_Type'(Src.Element.all); | |
111 | begin | |
112 | Dst := new Node_Type'(Element, null, null); | |
113 | exception | |
114 | when others => | |
115 | Free (Element); | |
116 | raise; | |
117 | end; | |
4c2d6a70 | 118 | |
8704d4b3 MH |
119 | Container.First := Dst; |
120 | Container.Last := Dst; | |
121 | Container.Length := 1; | |
122 | ||
123 | Src := Src.Next; | |
124 | while Src /= null loop | |
125 | declare | |
126 | Element : Element_Access := new Element_Type'(Src.Element.all); | |
4c2d6a70 | 127 | begin |
8704d4b3 | 128 | Dst := new Node_Type'(Element, null, Prev => Container.Last); |
4c2d6a70 AC |
129 | exception |
130 | when others => | |
8704d4b3 | 131 | Free (Element); |
4c2d6a70 AC |
132 | raise; |
133 | end; | |
4c2d6a70 AC |
134 | |
135 | Container.Last.Next := Dst; | |
136 | Container.Last := Dst; | |
8704d4b3 MH |
137 | Container.Length := Container.Length + 1; |
138 | ||
139 | Src := Src.Next; | |
4c2d6a70 AC |
140 | end loop; |
141 | end Adjust; | |
142 | ||
143 | ------------ | |
144 | -- Append -- | |
145 | ------------ | |
146 | ||
147 | procedure Append | |
148 | (Container : in out List; | |
149 | New_Item : Element_Type; | |
150 | Count : Count_Type := 1) | |
151 | is | |
152 | begin | |
153 | Insert (Container, No_Element, New_Item, Count); | |
154 | end Append; | |
155 | ||
156 | ----------- | |
157 | -- Clear -- | |
158 | ----------- | |
159 | ||
160 | procedure Clear (Container : in out List) is | |
8704d4b3 | 161 | X : Node_Access; |
67ce0d7e | 162 | pragma Warnings (Off, X); |
8704d4b3 | 163 | |
4c2d6a70 | 164 | begin |
8704d4b3 MH |
165 | if Container.Length = 0 then |
166 | pragma Assert (Container.First = null); | |
167 | pragma Assert (Container.Last = null); | |
168 | pragma Assert (Container.Busy = 0); | |
169 | pragma Assert (Container.Lock = 0); | |
170 | return; | |
171 | end if; | |
172 | ||
173 | pragma Assert (Container.First.Prev = null); | |
174 | pragma Assert (Container.Last.Next = null); | |
175 | ||
176 | if Container.Busy > 0 then | |
3837bc7f MH |
177 | raise Program_Error with |
178 | "attempt to tamper with elements (list is busy)"; | |
8704d4b3 MH |
179 | end if; |
180 | ||
181 | while Container.Length > 1 loop | |
182 | X := Container.First; | |
183 | pragma Assert (X.Next.Prev = Container.First); | |
184 | ||
185 | Container.First := X.Next; | |
186 | Container.First.Prev := null; | |
8704d4b3 | 187 | |
ba355842 | 188 | Container.Length := Container.Length - 1; |
8704d4b3 MH |
189 | |
190 | Free (X); | |
191 | end loop; | |
192 | ||
193 | X := Container.First; | |
194 | pragma Assert (X = Container.Last); | |
195 | ||
196 | Container.First := null; | |
197 | Container.Last := null; | |
198 | Container.Length := 0; | |
199 | ||
8704d4b3 | 200 | Free (X); |
4c2d6a70 AC |
201 | end Clear; |
202 | ||
203 | -------------- | |
204 | -- Contains -- | |
205 | -------------- | |
206 | ||
207 | function Contains | |
208 | (Container : List; | |
2368f04e MH |
209 | Item : Element_Type) return Boolean |
210 | is | |
4c2d6a70 AC |
211 | begin |
212 | return Find (Container, Item) /= No_Element; | |
213 | end Contains; | |
214 | ||
215 | ------------ | |
216 | -- Delete -- | |
217 | ------------ | |
218 | ||
219 | procedure Delete | |
220 | (Container : in out List; | |
221 | Position : in out Cursor; | |
222 | Count : Count_Type := 1) | |
223 | is | |
8704d4b3 MH |
224 | X : Node_Access; |
225 | ||
4c2d6a70 | 226 | begin |
8704d4b3 | 227 | if Position.Node = null then |
3837bc7f MH |
228 | raise Constraint_Error with |
229 | "Position cursor has no element"; | |
4c2d6a70 AC |
230 | end if; |
231 | ||
2368f04e | 232 | if Position.Node.Element = null then |
3837bc7f MH |
233 | raise Program_Error with |
234 | "Position cursor has no element"; | |
2368f04e MH |
235 | end if; |
236 | ||
ba355842 | 237 | if Position.Container /= Container'Unrestricted_Access then |
3837bc7f MH |
238 | raise Program_Error with |
239 | "Position cursor designates wrong container"; | |
4c2d6a70 AC |
240 | end if; |
241 | ||
2368f04e MH |
242 | pragma Assert (Vet (Position), "bad cursor in Delete"); |
243 | ||
8704d4b3 MH |
244 | if Position.Node = Container.First then |
245 | Delete_First (Container, Count); | |
2368f04e | 246 | Position := No_Element; -- Post-York behavior |
8704d4b3 MH |
247 | return; |
248 | end if; | |
249 | ||
250 | if Count = 0 then | |
2368f04e | 251 | Position := No_Element; -- Post-York behavior |
8704d4b3 MH |
252 | return; |
253 | end if; | |
254 | ||
255 | if Container.Busy > 0 then | |
3837bc7f MH |
256 | raise Program_Error with |
257 | "attempt to tamper with elements (list is busy)"; | |
8704d4b3 MH |
258 | end if; |
259 | ||
4c2d6a70 | 260 | for Index in 1 .. Count loop |
8704d4b3 MH |
261 | X := Position.Node; |
262 | Container.Length := Container.Length - 1; | |
263 | ||
264 | if X = Container.Last then | |
265 | Position := No_Element; | |
4c2d6a70 | 266 | |
8704d4b3 MH |
267 | Container.Last := X.Prev; |
268 | Container.Last.Next := null; | |
269 | ||
8704d4b3 | 270 | Free (X); |
4c2d6a70 AC |
271 | return; |
272 | end if; | |
8704d4b3 MH |
273 | |
274 | Position.Node := X.Next; | |
275 | ||
276 | X.Next.Prev := X.Prev; | |
277 | X.Prev.Next := X.Next; | |
278 | ||
8704d4b3 | 279 | Free (X); |
4c2d6a70 | 280 | end loop; |
2368f04e MH |
281 | |
282 | Position := No_Element; -- Post-York behavior | |
4c2d6a70 AC |
283 | end Delete; |
284 | ||
285 | ------------------ | |
286 | -- Delete_First -- | |
287 | ------------------ | |
288 | ||
289 | procedure Delete_First | |
290 | (Container : in out List; | |
291 | Count : Count_Type := 1) | |
292 | is | |
8704d4b3 MH |
293 | X : Node_Access; |
294 | ||
4c2d6a70 | 295 | begin |
8704d4b3 MH |
296 | if Count >= Container.Length then |
297 | Clear (Container); | |
298 | return; | |
299 | end if; | |
300 | ||
301 | if Count = 0 then | |
302 | return; | |
303 | end if; | |
304 | ||
305 | if Container.Busy > 0 then | |
3837bc7f MH |
306 | raise Program_Error with |
307 | "attempt to tamper with elements (list is busy)"; | |
8704d4b3 MH |
308 | end if; |
309 | ||
310 | for I in 1 .. Count loop | |
311 | X := Container.First; | |
312 | pragma Assert (X.Next.Prev = Container.First); | |
313 | ||
314 | Container.First := X.Next; | |
315 | Container.First.Prev := null; | |
316 | ||
317 | Container.Length := Container.Length - 1; | |
318 | ||
8704d4b3 | 319 | Free (X); |
4c2d6a70 AC |
320 | end loop; |
321 | end Delete_First; | |
322 | ||
323 | ----------------- | |
324 | -- Delete_Last -- | |
325 | ----------------- | |
326 | ||
327 | procedure Delete_Last | |
328 | (Container : in out List; | |
329 | Count : Count_Type := 1) | |
330 | is | |
8704d4b3 | 331 | X : Node_Access; |
4c2d6a70 AC |
332 | |
333 | begin | |
8704d4b3 MH |
334 | if Count >= Container.Length then |
335 | Clear (Container); | |
336 | return; | |
337 | end if; | |
4c2d6a70 | 338 | |
8704d4b3 MH |
339 | if Count = 0 then |
340 | return; | |
341 | end if; | |
4c2d6a70 | 342 | |
8704d4b3 | 343 | if Container.Busy > 0 then |
3837bc7f MH |
344 | raise Program_Error with |
345 | "attempt to tamper with elements (list is busy)"; | |
8704d4b3 | 346 | end if; |
4c2d6a70 | 347 | |
8704d4b3 MH |
348 | for I in 1 .. Count loop |
349 | X := Container.Last; | |
350 | pragma Assert (X.Prev.Next = Container.Last); | |
4c2d6a70 AC |
351 | |
352 | Container.Last := X.Prev; | |
353 | Container.Last.Next := null; | |
354 | ||
8704d4b3 | 355 | Container.Length := Container.Length - 1; |
4c2d6a70 | 356 | |
8704d4b3 MH |
357 | Free (X); |
358 | end loop; | |
359 | end Delete_Last; | |
4c2d6a70 AC |
360 | |
361 | ------------- | |
362 | -- Element -- | |
363 | ------------- | |
364 | ||
365 | function Element (Position : Cursor) return Element_Type is | |
366 | begin | |
ba355842 | 367 | if Position.Node = null then |
3837bc7f MH |
368 | raise Constraint_Error with |
369 | "Position cursor has no element"; | |
ba355842 | 370 | end if; |
8704d4b3 | 371 | |
2368f04e | 372 | if Position.Node.Element = null then |
3837bc7f MH |
373 | raise Program_Error with |
374 | "Position cursor has no element"; | |
2368f04e MH |
375 | end if; |
376 | ||
377 | pragma Assert (Vet (Position), "bad cursor in Element"); | |
378 | ||
4c2d6a70 AC |
379 | return Position.Node.Element.all; |
380 | end Element; | |
381 | ||
382 | ---------- | |
383 | -- Find -- | |
384 | ---------- | |
385 | ||
386 | function Find | |
387 | (Container : List; | |
388 | Item : Element_Type; | |
389 | Position : Cursor := No_Element) return Cursor | |
390 | is | |
391 | Node : Node_Access := Position.Node; | |
392 | ||
393 | begin | |
394 | if Node = null then | |
395 | Node := Container.First; | |
8704d4b3 MH |
396 | |
397 | else | |
2368f04e MH |
398 | if Node.Element = null then |
399 | raise Program_Error; | |
400 | end if; | |
ba355842 MH |
401 | |
402 | if Position.Container /= Container'Unrestricted_Access then | |
3837bc7f MH |
403 | raise Program_Error with |
404 | "Position cursor designates wrong container"; | |
8704d4b3 | 405 | end if; |
2368f04e MH |
406 | |
407 | pragma Assert (Vet (Position), "bad cursor in Find"); | |
4c2d6a70 AC |
408 | end if; |
409 | ||
410 | while Node /= null loop | |
8704d4b3 | 411 | if Node.Element.all = Item then |
4c2d6a70 AC |
412 | return Cursor'(Container'Unchecked_Access, Node); |
413 | end if; | |
414 | ||
415 | Node := Node.Next; | |
416 | end loop; | |
417 | ||
418 | return No_Element; | |
419 | end Find; | |
420 | ||
421 | ----------- | |
422 | -- First -- | |
423 | ----------- | |
424 | ||
425 | function First (Container : List) return Cursor is | |
426 | begin | |
427 | if Container.First = null then | |
428 | return No_Element; | |
429 | end if; | |
430 | ||
431 | return Cursor'(Container'Unchecked_Access, Container.First); | |
432 | end First; | |
433 | ||
434 | ------------------- | |
435 | -- First_Element -- | |
436 | ------------------- | |
437 | ||
438 | function First_Element (Container : List) return Element_Type is | |
439 | begin | |
ba355842 | 440 | if Container.First = null then |
3837bc7f | 441 | raise Constraint_Error with "list is empty"; |
ba355842 MH |
442 | end if; |
443 | ||
4c2d6a70 AC |
444 | return Container.First.Element.all; |
445 | end First_Element; | |
446 | ||
ba355842 MH |
447 | ---------- |
448 | -- Free -- | |
449 | ---------- | |
450 | ||
451 | procedure Free (X : in out Node_Access) is | |
452 | procedure Deallocate is | |
453 | new Ada.Unchecked_Deallocation (Node_Type, Node_Access); | |
454 | ||
455 | begin | |
456 | X.Next := X; | |
457 | X.Prev := X; | |
458 | ||
459 | begin | |
460 | Free (X.Element); | |
461 | exception | |
462 | when others => | |
463 | X.Element := null; | |
464 | Deallocate (X); | |
465 | raise; | |
466 | end; | |
467 | ||
468 | Deallocate (X); | |
469 | end Free; | |
470 | ||
8704d4b3 MH |
471 | --------------------- |
472 | -- Generic_Sorting -- | |
473 | --------------------- | |
4c2d6a70 | 474 | |
8704d4b3 | 475 | package body Generic_Sorting is |
4c2d6a70 | 476 | |
8704d4b3 MH |
477 | --------------- |
478 | -- Is_Sorted -- | |
479 | --------------- | |
480 | ||
481 | function Is_Sorted (Container : List) return Boolean is | |
482 | Node : Node_Access := Container.First; | |
483 | ||
484 | begin | |
485 | for I in 2 .. Container.Length loop | |
486 | if Node.Next.Element.all < Node.Element.all then | |
487 | return False; | |
488 | end if; | |
489 | ||
490 | Node := Node.Next; | |
491 | end loop; | |
492 | ||
493 | return True; | |
494 | end Is_Sorted; | |
495 | ||
496 | ----------- | |
497 | -- Merge -- | |
498 | ----------- | |
4c2d6a70 | 499 | |
8704d4b3 MH |
500 | procedure Merge |
501 | (Target : in out List; | |
502 | Source : in out List) | |
503 | is | |
3837bc7f | 504 | LI, RI : Cursor; |
8704d4b3 MH |
505 | |
506 | begin | |
507 | if Target'Address = Source'Address then | |
4c2d6a70 AC |
508 | return; |
509 | end if; | |
510 | ||
3837bc7f MH |
511 | if Target.Busy > 0 then |
512 | raise Program_Error with | |
513 | "attempt to tamper with elements of Target (list is busy)"; | |
514 | end if; | |
515 | ||
516 | if Source.Busy > 0 then | |
517 | raise Program_Error with | |
518 | "attempt to tamper with elements of Source (list is busy)"; | |
4c2d6a70 | 519 | end if; |
4c2d6a70 | 520 | |
8704d4b3 MH |
521 | LI := First (Target); |
522 | RI := First (Source); | |
523 | while RI.Node /= null loop | |
7cdc672b MH |
524 | pragma Assert (RI.Node.Next = null |
525 | or else not (RI.Node.Next.Element.all < | |
526 | RI.Node.Element.all)); | |
527 | ||
8704d4b3 MH |
528 | if LI.Node = null then |
529 | Splice (Target, No_Element, Source); | |
530 | return; | |
531 | end if; | |
4c2d6a70 | 532 | |
7cdc672b MH |
533 | pragma Assert (LI.Node.Next = null |
534 | or else not (LI.Node.Next.Element.all < | |
535 | LI.Node.Element.all)); | |
536 | ||
8704d4b3 MH |
537 | if RI.Node.Element.all < LI.Node.Element.all then |
538 | declare | |
539 | RJ : Cursor := RI; | |
67ce0d7e | 540 | pragma Warnings (Off, RJ); |
8704d4b3 MH |
541 | begin |
542 | RI.Node := RI.Node.Next; | |
543 | Splice (Target, LI, Source, RJ); | |
544 | end; | |
4c2d6a70 | 545 | |
8704d4b3 MH |
546 | else |
547 | LI.Node := LI.Node.Next; | |
548 | end if; | |
549 | end loop; | |
550 | end Merge; | |
4c2d6a70 | 551 | |
8704d4b3 MH |
552 | ---------- |
553 | -- Sort -- | |
554 | ---------- | |
4c2d6a70 | 555 | |
8704d4b3 MH |
556 | procedure Sort (Container : in out List) is |
557 | procedure Partition (Pivot : Node_Access; Back : Node_Access); | |
4c2d6a70 | 558 | |
8704d4b3 | 559 | procedure Sort (Front, Back : Node_Access); |
4c2d6a70 | 560 | |
8704d4b3 MH |
561 | --------------- |
562 | -- Partition -- | |
563 | --------------- | |
4c2d6a70 | 564 | |
8704d4b3 MH |
565 | procedure Partition (Pivot : Node_Access; Back : Node_Access) is |
566 | Node : Node_Access := Pivot.Next; | |
4c2d6a70 | 567 | |
8704d4b3 MH |
568 | begin |
569 | while Node /= Back loop | |
570 | if Node.Element.all < Pivot.Element.all then | |
571 | declare | |
572 | Prev : constant Node_Access := Node.Prev; | |
573 | Next : constant Node_Access := Node.Next; | |
574 | begin | |
575 | Prev.Next := Next; | |
576 | ||
577 | if Next = null then | |
578 | Container.Last := Prev; | |
579 | else | |
580 | Next.Prev := Prev; | |
581 | end if; | |
582 | ||
583 | Node.Next := Pivot; | |
584 | Node.Prev := Pivot.Prev; | |
585 | ||
586 | Pivot.Prev := Node; | |
587 | ||
588 | if Node.Prev = null then | |
589 | Container.First := Node; | |
590 | else | |
591 | Node.Prev.Next := Node; | |
592 | end if; | |
593 | ||
594 | Node := Next; | |
595 | end; | |
4c2d6a70 | 596 | |
8704d4b3 MH |
597 | else |
598 | Node := Node.Next; | |
599 | end if; | |
600 | end loop; | |
601 | end Partition; | |
4c2d6a70 | 602 | |
8704d4b3 MH |
603 | ---------- |
604 | -- Sort -- | |
605 | ---------- | |
4c2d6a70 | 606 | |
8704d4b3 MH |
607 | procedure Sort (Front, Back : Node_Access) is |
608 | Pivot : Node_Access; | |
4c2d6a70 | 609 | |
8704d4b3 MH |
610 | begin |
611 | if Front = null then | |
612 | Pivot := Container.First; | |
4c2d6a70 | 613 | else |
8704d4b3 | 614 | Pivot := Front.Next; |
4c2d6a70 | 615 | end if; |
4c2d6a70 | 616 | |
8704d4b3 MH |
617 | if Pivot /= Back then |
618 | Partition (Pivot, Back); | |
619 | Sort (Front, Pivot); | |
620 | Sort (Pivot, Back); | |
621 | end if; | |
622 | end Sort; | |
4c2d6a70 | 623 | |
8704d4b3 | 624 | -- Start of processing for Sort |
4c2d6a70 AC |
625 | |
626 | begin | |
8704d4b3 MH |
627 | if Container.Length <= 1 then |
628 | return; | |
4c2d6a70 AC |
629 | end if; |
630 | ||
8704d4b3 MH |
631 | pragma Assert (Container.First.Prev = null); |
632 | pragma Assert (Container.Last.Next = null); | |
633 | ||
634 | if Container.Busy > 0 then | |
3837bc7f MH |
635 | raise Program_Error with |
636 | "attempt to tamper with elements (list is busy)"; | |
4c2d6a70 | 637 | end if; |
4c2d6a70 | 638 | |
8704d4b3 | 639 | Sort (Front => null, Back => null); |
4c2d6a70 | 640 | |
8704d4b3 MH |
641 | pragma Assert (Container.First.Prev = null); |
642 | pragma Assert (Container.Last.Next = null); | |
643 | end Sort; | |
4c2d6a70 | 644 | |
8704d4b3 | 645 | end Generic_Sorting; |
4c2d6a70 AC |
646 | |
647 | ----------------- | |
648 | -- Has_Element -- | |
649 | ----------------- | |
650 | ||
651 | function Has_Element (Position : Cursor) return Boolean is | |
652 | begin | |
ba355842 MH |
653 | pragma Assert (Vet (Position), "bad cursor in Has_Element"); |
654 | return Position.Node /= null; | |
4c2d6a70 AC |
655 | end Has_Element; |
656 | ||
657 | ------------ | |
658 | -- Insert -- | |
659 | ------------ | |
660 | ||
661 | procedure Insert | |
662 | (Container : in out List; | |
663 | Before : Cursor; | |
664 | New_Item : Element_Type; | |
665 | Position : out Cursor; | |
666 | Count : Count_Type := 1) | |
667 | is | |
668 | New_Node : Node_Access; | |
669 | ||
670 | begin | |
2368f04e MH |
671 | if Before.Container /= null then |
672 | if Before.Container /= Container'Unrestricted_Access then | |
3837bc7f MH |
673 | raise Program_Error with |
674 | "attempt to tamper with elements (list is busy)"; | |
2368f04e | 675 | end if; |
8704d4b3 | 676 | |
2368f04e MH |
677 | if Before.Node = null |
678 | or else Before.Node.Element = null | |
679 | then | |
3837bc7f MH |
680 | raise Program_Error with |
681 | "Before cursor has no element"; | |
2368f04e MH |
682 | end if; |
683 | ||
684 | pragma Assert (Vet (Before), "bad cursor in Insert"); | |
4c2d6a70 AC |
685 | end if; |
686 | ||
687 | if Count = 0 then | |
688 | Position := Before; | |
689 | return; | |
690 | end if; | |
691 | ||
8704d4b3 | 692 | if Container.Length > Count_Type'Last - Count then |
3837bc7f | 693 | raise Constraint_Error with "new length exceeds maximum"; |
8704d4b3 MH |
694 | end if; |
695 | ||
696 | if Container.Busy > 0 then | |
3837bc7f MH |
697 | raise Program_Error with |
698 | "attempt to tamper with elements (list is busy)"; | |
8704d4b3 MH |
699 | end if; |
700 | ||
4c2d6a70 AC |
701 | declare |
702 | Element : Element_Access := new Element_Type'(New_Item); | |
703 | begin | |
704 | New_Node := new Node_Type'(Element, null, null); | |
705 | exception | |
706 | when others => | |
707 | Free (Element); | |
708 | raise; | |
709 | end; | |
710 | ||
711 | Insert_Internal (Container, Before.Node, New_Node); | |
8704d4b3 | 712 | Position := Cursor'(Container'Unchecked_Access, New_Node); |
4c2d6a70 AC |
713 | |
714 | for J in Count_Type'(2) .. Count loop | |
715 | ||
716 | declare | |
717 | Element : Element_Access := new Element_Type'(New_Item); | |
718 | begin | |
719 | New_Node := new Node_Type'(Element, null, null); | |
720 | exception | |
721 | when others => | |
722 | Free (Element); | |
723 | raise; | |
724 | end; | |
725 | ||
726 | Insert_Internal (Container, Before.Node, New_Node); | |
727 | end loop; | |
728 | end Insert; | |
729 | ||
730 | procedure Insert | |
731 | (Container : in out List; | |
732 | Before : Cursor; | |
733 | New_Item : Element_Type; | |
734 | Count : Count_Type := 1) | |
735 | is | |
736 | Position : Cursor; | |
67ce0d7e | 737 | pragma Unreferenced (Position); |
4c2d6a70 AC |
738 | begin |
739 | Insert (Container, Before, New_Item, Position, Count); | |
740 | end Insert; | |
741 | ||
742 | --------------------- | |
743 | -- Insert_Internal -- | |
744 | --------------------- | |
745 | ||
746 | procedure Insert_Internal | |
747 | (Container : in out List; | |
748 | Before : Node_Access; | |
749 | New_Node : Node_Access) | |
750 | is | |
751 | begin | |
752 | if Container.Length = 0 then | |
753 | pragma Assert (Before = null); | |
754 | pragma Assert (Container.First = null); | |
755 | pragma Assert (Container.Last = null); | |
756 | ||
757 | Container.First := New_Node; | |
758 | Container.Last := New_Node; | |
759 | ||
760 | elsif Before = null then | |
761 | pragma Assert (Container.Last.Next = null); | |
762 | ||
763 | Container.Last.Next := New_Node; | |
764 | New_Node.Prev := Container.Last; | |
765 | ||
766 | Container.Last := New_Node; | |
767 | ||
768 | elsif Before = Container.First then | |
769 | pragma Assert (Container.First.Prev = null); | |
770 | ||
771 | Container.First.Prev := New_Node; | |
772 | New_Node.Next := Container.First; | |
773 | ||
774 | Container.First := New_Node; | |
775 | ||
776 | else | |
777 | pragma Assert (Container.First.Prev = null); | |
778 | pragma Assert (Container.Last.Next = null); | |
779 | ||
780 | New_Node.Next := Before; | |
781 | New_Node.Prev := Before.Prev; | |
782 | ||
783 | Before.Prev.Next := New_Node; | |
784 | Before.Prev := New_Node; | |
785 | end if; | |
786 | ||
787 | Container.Length := Container.Length + 1; | |
788 | end Insert_Internal; | |
789 | ||
790 | -------------- | |
791 | -- Is_Empty -- | |
792 | -------------- | |
793 | ||
794 | function Is_Empty (Container : List) return Boolean is | |
795 | begin | |
796 | return Container.Length = 0; | |
797 | end Is_Empty; | |
798 | ||
799 | ------------- | |
800 | -- Iterate -- | |
801 | ------------- | |
802 | ||
803 | procedure Iterate | |
804 | (Container : List; | |
0ae9f22f | 805 | Process : not null access procedure (Position : Cursor)) |
4c2d6a70 | 806 | is |
8704d4b3 MH |
807 | C : List renames Container'Unrestricted_Access.all; |
808 | B : Natural renames C.Busy; | |
809 | ||
4c2d6a70 | 810 | Node : Node_Access := Container.First; |
8704d4b3 | 811 | |
4c2d6a70 | 812 | begin |
8704d4b3 MH |
813 | B := B + 1; |
814 | ||
815 | begin | |
816 | while Node /= null loop | |
817 | Process (Cursor'(Container'Unchecked_Access, Node)); | |
818 | Node := Node.Next; | |
819 | end loop; | |
820 | exception | |
821 | when others => | |
822 | B := B - 1; | |
823 | raise; | |
824 | end; | |
825 | ||
826 | B := B - 1; | |
4c2d6a70 AC |
827 | end Iterate; |
828 | ||
4c2d6a70 AC |
829 | ---------- |
830 | -- Last -- | |
831 | ---------- | |
832 | ||
833 | function Last (Container : List) return Cursor is | |
834 | begin | |
835 | if Container.Last = null then | |
836 | return No_Element; | |
837 | end if; | |
838 | ||
839 | return Cursor'(Container'Unchecked_Access, Container.Last); | |
840 | end Last; | |
841 | ||
842 | ------------------ | |
843 | -- Last_Element -- | |
844 | ------------------ | |
845 | ||
846 | function Last_Element (Container : List) return Element_Type is | |
847 | begin | |
ba355842 | 848 | if Container.Last = null then |
3837bc7f | 849 | raise Constraint_Error with "list is empty"; |
ba355842 MH |
850 | end if; |
851 | ||
4c2d6a70 AC |
852 | return Container.Last.Element.all; |
853 | end Last_Element; | |
854 | ||
855 | ------------ | |
856 | -- Length -- | |
857 | ------------ | |
858 | ||
859 | function Length (Container : List) return Count_Type is | |
860 | begin | |
861 | return Container.Length; | |
862 | end Length; | |
863 | ||
ba355842 MH |
864 | ---------- |
865 | -- Move -- | |
866 | ---------- | |
867 | ||
868 | procedure Move (Target : in out List; Source : in out List) is | |
869 | begin | |
870 | if Target'Address = Source'Address then | |
871 | return; | |
872 | end if; | |
873 | ||
874 | if Source.Busy > 0 then | |
3837bc7f MH |
875 | raise Program_Error with |
876 | "attempt to tamper with elements of Source (list is busy)"; | |
ba355842 MH |
877 | end if; |
878 | ||
879 | Clear (Target); | |
880 | ||
881 | Target.First := Source.First; | |
882 | Source.First := null; | |
883 | ||
884 | Target.Last := Source.Last; | |
885 | Source.Last := null; | |
886 | ||
887 | Target.Length := Source.Length; | |
888 | Source.Length := 0; | |
889 | end Move; | |
890 | ||
4c2d6a70 AC |
891 | ---------- |
892 | -- Next -- | |
893 | ---------- | |
894 | ||
895 | procedure Next (Position : in out Cursor) is | |
896 | begin | |
3837bc7f | 897 | Position := Next (Position); |
4c2d6a70 AC |
898 | end Next; |
899 | ||
900 | function Next (Position : Cursor) return Cursor is | |
901 | begin | |
902 | if Position.Node = null then | |
903 | return No_Element; | |
904 | end if; | |
905 | ||
3837bc7f MH |
906 | pragma Assert (Vet (Position), "bad cursor in Next"); |
907 | ||
4c2d6a70 AC |
908 | declare |
909 | Next_Node : constant Node_Access := Position.Node.Next; | |
910 | begin | |
911 | if Next_Node = null then | |
912 | return No_Element; | |
913 | end if; | |
914 | ||
915 | return Cursor'(Position.Container, Next_Node); | |
916 | end; | |
917 | end Next; | |
918 | ||
919 | ------------- | |
920 | -- Prepend -- | |
921 | ------------- | |
922 | ||
923 | procedure Prepend | |
924 | (Container : in out List; | |
925 | New_Item : Element_Type; | |
926 | Count : Count_Type := 1) | |
927 | is | |
928 | begin | |
929 | Insert (Container, First (Container), New_Item, Count); | |
930 | end Prepend; | |
931 | ||
932 | -------------- | |
933 | -- Previous -- | |
934 | -------------- | |
935 | ||
936 | procedure Previous (Position : in out Cursor) is | |
937 | begin | |
3837bc7f | 938 | Position := Previous (Position); |
4c2d6a70 AC |
939 | end Previous; |
940 | ||
941 | function Previous (Position : Cursor) return Cursor is | |
942 | begin | |
943 | if Position.Node = null then | |
944 | return No_Element; | |
945 | end if; | |
946 | ||
3837bc7f MH |
947 | pragma Assert (Vet (Position), "bad cursor in Previous"); |
948 | ||
4c2d6a70 AC |
949 | declare |
950 | Prev_Node : constant Node_Access := Position.Node.Prev; | |
951 | begin | |
952 | if Prev_Node = null then | |
953 | return No_Element; | |
954 | end if; | |
955 | ||
956 | return Cursor'(Position.Container, Prev_Node); | |
957 | end; | |
958 | end Previous; | |
959 | ||
960 | ------------------- | |
961 | -- Query_Element -- | |
962 | ------------------- | |
963 | ||
964 | procedure Query_Element | |
965 | (Position : Cursor; | |
0ae9f22f | 966 | Process : not null access procedure (Element : Element_Type)) |
4c2d6a70 AC |
967 | is |
968 | begin | |
ba355842 | 969 | if Position.Node = null then |
3837bc7f MH |
970 | raise Constraint_Error with |
971 | "Position cursor has no element"; | |
ba355842 MH |
972 | end if; |
973 | ||
2368f04e | 974 | if Position.Node.Element = null then |
3837bc7f MH |
975 | raise Program_Error with |
976 | "Position cursor has no element"; | |
2368f04e MH |
977 | end if; |
978 | ||
979 | pragma Assert (Vet (Position), "bad cursor in Query_Element"); | |
980 | ||
ba355842 MH |
981 | declare |
982 | C : List renames Position.Container.all'Unrestricted_Access.all; | |
983 | B : Natural renames C.Busy; | |
984 | L : Natural renames C.Lock; | |
8704d4b3 MH |
985 | |
986 | begin | |
ba355842 MH |
987 | B := B + 1; |
988 | L := L + 1; | |
8704d4b3 | 989 | |
ba355842 MH |
990 | begin |
991 | Process (Position.Node.Element.all); | |
992 | exception | |
993 | when others => | |
994 | L := L - 1; | |
995 | B := B - 1; | |
996 | raise; | |
997 | end; | |
998 | ||
999 | L := L - 1; | |
1000 | B := B - 1; | |
1001 | end; | |
4c2d6a70 AC |
1002 | end Query_Element; |
1003 | ||
1004 | ---------- | |
1005 | -- Read -- | |
1006 | ---------- | |
1007 | ||
1008 | procedure Read | |
3837bc7f | 1009 | (Stream : not null access Root_Stream_Type'Class; |
4c2d6a70 AC |
1010 | Item : out List) |
1011 | is | |
8704d4b3 MH |
1012 | N : Count_Type'Base; |
1013 | Dst : Node_Access; | |
4c2d6a70 AC |
1014 | |
1015 | begin | |
8704d4b3 | 1016 | Clear (Item); |
4c2d6a70 AC |
1017 | |
1018 | Count_Type'Base'Read (Stream, N); | |
1019 | ||
1020 | if N = 0 then | |
1021 | return; | |
1022 | end if; | |
1023 | ||
8704d4b3 MH |
1024 | declare |
1025 | Element : Element_Access := | |
1026 | new Element_Type'(Element_Type'Input (Stream)); | |
4c2d6a70 | 1027 | begin |
8704d4b3 | 1028 | Dst := new Node_Type'(Element, null, null); |
4c2d6a70 AC |
1029 | exception |
1030 | when others => | |
8704d4b3 | 1031 | Free (Element); |
4c2d6a70 AC |
1032 | raise; |
1033 | end; | |
1034 | ||
8704d4b3 MH |
1035 | Item.First := Dst; |
1036 | Item.Last := Dst; | |
1037 | Item.Length := 1; | |
4c2d6a70 | 1038 | |
8704d4b3 MH |
1039 | while Item.Length < N loop |
1040 | declare | |
1041 | Element : Element_Access := | |
1042 | new Element_Type'(Element_Type'Input (Stream)); | |
4c2d6a70 | 1043 | begin |
8704d4b3 | 1044 | Dst := new Node_Type'(Element, Next => null, Prev => Item.Last); |
4c2d6a70 AC |
1045 | exception |
1046 | when others => | |
8704d4b3 | 1047 | Free (Element); |
4c2d6a70 AC |
1048 | raise; |
1049 | end; | |
1050 | ||
8704d4b3 MH |
1051 | Item.Last.Next := Dst; |
1052 | Item.Last := Dst; | |
1053 | Item.Length := Item.Length + 1; | |
4c2d6a70 AC |
1054 | end loop; |
1055 | end Read; | |
1056 | ||
2368f04e | 1057 | procedure Read |
3837bc7f | 1058 | (Stream : not null access Root_Stream_Type'Class; |
2368f04e MH |
1059 | Item : out Cursor) |
1060 | is | |
1061 | begin | |
3837bc7f | 1062 | raise Program_Error with "attempt to stream list cursor"; |
2368f04e MH |
1063 | end Read; |
1064 | ||
4c2d6a70 AC |
1065 | --------------------- |
1066 | -- Replace_Element -- | |
1067 | --------------------- | |
1068 | ||
1069 | procedure Replace_Element | |
2368f04e MH |
1070 | (Container : in out List; |
1071 | Position : Cursor; | |
1072 | New_Item : Element_Type) | |
4c2d6a70 | 1073 | is |
4c2d6a70 | 1074 | begin |
ba355842 | 1075 | if Position.Container = null then |
3837bc7f | 1076 | raise Constraint_Error with "Position cursor has no element"; |
ba355842 MH |
1077 | end if; |
1078 | ||
2368f04e | 1079 | if Position.Container /= Container'Unchecked_Access then |
3837bc7f MH |
1080 | raise Program_Error with |
1081 | "Position cursor designates wrong container"; | |
8704d4b3 MH |
1082 | end if; |
1083 | ||
3837bc7f MH |
1084 | if Container.Lock > 0 then |
1085 | raise Program_Error with | |
1086 | "attempt to tamper with cursors (list is locked)"; | |
4c2d6a70 AC |
1087 | end if; |
1088 | ||
2368f04e | 1089 | if Position.Node.Element = null then |
3837bc7f MH |
1090 | raise Program_Error with |
1091 | "Position cursor has no element"; | |
2368f04e | 1092 | end if; |
8704d4b3 | 1093 | |
2368f04e | 1094 | pragma Assert (Vet (Position), "bad cursor in Replace_Element"); |
4c2d6a70 | 1095 | |
2368f04e MH |
1096 | declare |
1097 | X : Element_Access := Position.Node.Element; | |
8704d4b3 MH |
1098 | |
1099 | begin | |
2368f04e MH |
1100 | Position.Node.Element := new Element_Type'(New_Item); |
1101 | Free (X); | |
8704d4b3 | 1102 | end; |
2368f04e | 1103 | end Replace_Element; |
8704d4b3 | 1104 | |
2368f04e MH |
1105 | ---------------------- |
1106 | -- Reverse_Elements -- | |
1107 | ---------------------- | |
4c2d6a70 | 1108 | |
2368f04e | 1109 | procedure Reverse_Elements (Container : in out List) is |
4c2d6a70 AC |
1110 | I : Node_Access := Container.First; |
1111 | J : Node_Access := Container.Last; | |
1112 | ||
1113 | procedure Swap (L, R : Node_Access); | |
1114 | ||
1115 | ---------- | |
1116 | -- Swap -- | |
1117 | ---------- | |
1118 | ||
1119 | procedure Swap (L, R : Node_Access) is | |
1120 | LN : constant Node_Access := L.Next; | |
1121 | LP : constant Node_Access := L.Prev; | |
1122 | ||
1123 | RN : constant Node_Access := R.Next; | |
1124 | RP : constant Node_Access := R.Prev; | |
1125 | ||
1126 | begin | |
1127 | if LP /= null then | |
1128 | LP.Next := R; | |
1129 | end if; | |
1130 | ||
1131 | if RN /= null then | |
1132 | RN.Prev := L; | |
1133 | end if; | |
1134 | ||
1135 | L.Next := RN; | |
1136 | R.Prev := LP; | |
1137 | ||
1138 | if LN = R then | |
1139 | pragma Assert (RP = L); | |
1140 | ||
1141 | L.Prev := R; | |
1142 | R.Next := L; | |
1143 | ||
1144 | else | |
1145 | L.Prev := RP; | |
1146 | RP.Next := L; | |
1147 | ||
1148 | R.Next := LN; | |
1149 | LN.Prev := R; | |
1150 | end if; | |
1151 | end Swap; | |
1152 | ||
2368f04e | 1153 | -- Start of processing for Reverse_Elements |
4c2d6a70 AC |
1154 | |
1155 | begin | |
1156 | if Container.Length <= 1 then | |
1157 | return; | |
1158 | end if; | |
1159 | ||
8704d4b3 MH |
1160 | pragma Assert (Container.First.Prev = null); |
1161 | pragma Assert (Container.Last.Next = null); | |
1162 | ||
1163 | if Container.Busy > 0 then | |
3837bc7f MH |
1164 | raise Program_Error with |
1165 | "attempt to tamper with elements (list is busy)"; | |
8704d4b3 MH |
1166 | end if; |
1167 | ||
4c2d6a70 AC |
1168 | Container.First := J; |
1169 | Container.Last := I; | |
1170 | loop | |
1171 | Swap (L => I, R => J); | |
1172 | ||
1173 | J := J.Next; | |
1174 | exit when I = J; | |
1175 | ||
1176 | I := I.Prev; | |
1177 | exit when I = J; | |
1178 | ||
1179 | Swap (L => J, R => I); | |
1180 | ||
1181 | I := I.Next; | |
1182 | exit when I = J; | |
1183 | ||
1184 | J := J.Prev; | |
1185 | exit when I = J; | |
1186 | end loop; | |
1187 | ||
1188 | pragma Assert (Container.First.Prev = null); | |
1189 | pragma Assert (Container.Last.Next = null); | |
2368f04e MH |
1190 | end Reverse_Elements; |
1191 | ||
1192 | ------------------ | |
1193 | -- Reverse_Find -- | |
1194 | ------------------ | |
1195 | ||
1196 | function Reverse_Find | |
1197 | (Container : List; | |
1198 | Item : Element_Type; | |
1199 | Position : Cursor := No_Element) return Cursor | |
1200 | is | |
1201 | Node : Node_Access := Position.Node; | |
1202 | ||
1203 | begin | |
1204 | if Node = null then | |
1205 | Node := Container.Last; | |
1206 | ||
1207 | else | |
1208 | if Node.Element = null then | |
3837bc7f | 1209 | raise Program_Error with "Position cursor has no element"; |
2368f04e MH |
1210 | end if; |
1211 | ||
1212 | if Position.Container /= Container'Unrestricted_Access then | |
3837bc7f MH |
1213 | raise Program_Error with |
1214 | "Position cursor designates wrong container"; | |
2368f04e MH |
1215 | end if; |
1216 | ||
1217 | pragma Assert (Vet (Position), "bad cursor in Reverse_Find"); | |
1218 | end if; | |
1219 | ||
1220 | while Node /= null loop | |
1221 | if Node.Element.all = Item then | |
1222 | return Cursor'(Container'Unchecked_Access, Node); | |
1223 | end if; | |
1224 | ||
1225 | Node := Node.Prev; | |
1226 | end loop; | |
1227 | ||
1228 | return No_Element; | |
1229 | end Reverse_Find; | |
1230 | ||
1231 | --------------------- | |
1232 | -- Reverse_Iterate -- | |
1233 | --------------------- | |
1234 | ||
1235 | procedure Reverse_Iterate | |
1236 | (Container : List; | |
0ae9f22f | 1237 | Process : not null access procedure (Position : Cursor)) |
2368f04e MH |
1238 | is |
1239 | C : List renames Container'Unrestricted_Access.all; | |
1240 | B : Natural renames C.Busy; | |
1241 | ||
1242 | Node : Node_Access := Container.Last; | |
1243 | ||
1244 | begin | |
1245 | B := B + 1; | |
1246 | ||
1247 | begin | |
1248 | while Node /= null loop | |
1249 | Process (Cursor'(Container'Unchecked_Access, Node)); | |
1250 | Node := Node.Prev; | |
1251 | end loop; | |
1252 | exception | |
1253 | when others => | |
1254 | B := B - 1; | |
1255 | raise; | |
1256 | end; | |
1257 | ||
1258 | B := B - 1; | |
1259 | end Reverse_Iterate; | |
4c2d6a70 AC |
1260 | |
1261 | ------------ | |
1262 | -- Splice -- | |
1263 | ------------ | |
1264 | ||
1265 | procedure Splice | |
1266 | (Target : in out List; | |
1267 | Before : Cursor; | |
1268 | Source : in out List) | |
1269 | is | |
1270 | begin | |
2368f04e MH |
1271 | if Before.Container /= null then |
1272 | if Before.Container /= Target'Unrestricted_Access then | |
3837bc7f MH |
1273 | raise Program_Error with |
1274 | "Before cursor designates wrong container"; | |
2368f04e | 1275 | end if; |
8704d4b3 | 1276 | |
2368f04e MH |
1277 | if Before.Node = null |
1278 | or else Before.Node.Element = null | |
1279 | then | |
3837bc7f MH |
1280 | raise Program_Error with |
1281 | "Before cursor has no element"; | |
2368f04e MH |
1282 | end if; |
1283 | ||
1284 | pragma Assert (Vet (Before), "bad cursor in Splice"); | |
4c2d6a70 AC |
1285 | end if; |
1286 | ||
1287 | if Target'Address = Source'Address | |
1288 | or else Source.Length = 0 | |
1289 | then | |
1290 | return; | |
1291 | end if; | |
1292 | ||
8704d4b3 MH |
1293 | pragma Assert (Source.First.Prev = null); |
1294 | pragma Assert (Source.Last.Next = null); | |
1295 | ||
1296 | if Target.Length > Count_Type'Last - Source.Length then | |
3837bc7f | 1297 | raise Constraint_Error with "new length exceeds maximum"; |
8704d4b3 MH |
1298 | end if; |
1299 | ||
3837bc7f MH |
1300 | if Target.Busy > 0 then |
1301 | raise Program_Error with | |
1302 | "attempt to tamper with elements of Target (list is busy)"; | |
1303 | end if; | |
1304 | ||
1305 | if Source.Busy > 0 then | |
1306 | raise Program_Error with | |
1307 | "attempt to tamper with elements of Source (list is busy)"; | |
8704d4b3 MH |
1308 | end if; |
1309 | ||
4c2d6a70 AC |
1310 | if Target.Length = 0 then |
1311 | pragma Assert (Before = No_Element); | |
8704d4b3 MH |
1312 | pragma Assert (Target.First = null); |
1313 | pragma Assert (Target.Last = null); | |
4c2d6a70 AC |
1314 | |
1315 | Target.First := Source.First; | |
1316 | Target.Last := Source.Last; | |
1317 | ||
1318 | elsif Before.Node = null then | |
1319 | pragma Assert (Target.Last.Next = null); | |
1320 | ||
1321 | Target.Last.Next := Source.First; | |
1322 | Source.First.Prev := Target.Last; | |
1323 | ||
1324 | Target.Last := Source.Last; | |
1325 | ||
1326 | elsif Before.Node = Target.First then | |
1327 | pragma Assert (Target.First.Prev = null); | |
1328 | ||
1329 | Source.Last.Next := Target.First; | |
1330 | Target.First.Prev := Source.Last; | |
1331 | ||
1332 | Target.First := Source.First; | |
1333 | ||
1334 | else | |
8704d4b3 | 1335 | pragma Assert (Target.Length >= 2); |
4c2d6a70 AC |
1336 | Before.Node.Prev.Next := Source.First; |
1337 | Source.First.Prev := Before.Node.Prev; | |
1338 | ||
1339 | Before.Node.Prev := Source.Last; | |
1340 | Source.Last.Next := Before.Node; | |
1341 | end if; | |
1342 | ||
1343 | Source.First := null; | |
1344 | Source.Last := null; | |
1345 | ||
1346 | Target.Length := Target.Length + Source.Length; | |
1347 | Source.Length := 0; | |
1348 | end Splice; | |
1349 | ||
1350 | procedure Splice | |
7cdc672b MH |
1351 | (Container : in out List; |
1352 | Before : Cursor; | |
3837bc7f | 1353 | Position : Cursor) |
4c2d6a70 | 1354 | is |
4c2d6a70 | 1355 | begin |
2368f04e | 1356 | if Before.Container /= null then |
7cdc672b | 1357 | if Before.Container /= Container'Unchecked_Access then |
3837bc7f MH |
1358 | raise Program_Error with |
1359 | "Before cursor designates wrong container"; | |
2368f04e | 1360 | end if; |
8704d4b3 | 1361 | |
2368f04e MH |
1362 | if Before.Node = null |
1363 | or else Before.Node.Element = null | |
1364 | then | |
3837bc7f MH |
1365 | raise Program_Error with |
1366 | "Before cursor has no element"; | |
2368f04e MH |
1367 | end if; |
1368 | ||
1369 | pragma Assert (Vet (Before), "bad Before cursor in Splice"); | |
4c2d6a70 AC |
1370 | end if; |
1371 | ||
8704d4b3 | 1372 | if Position.Node = null then |
3837bc7f | 1373 | raise Constraint_Error with "Position cursor has no element"; |
8704d4b3 MH |
1374 | end if; |
1375 | ||
2368f04e | 1376 | if Position.Node.Element = null then |
3837bc7f | 1377 | raise Program_Error with "Position cursor has no element"; |
2368f04e MH |
1378 | end if; |
1379 | ||
7cdc672b | 1380 | if Position.Container /= Container'Unrestricted_Access then |
3837bc7f MH |
1381 | raise Program_Error with |
1382 | "Position cursor designates wrong container"; | |
4c2d6a70 AC |
1383 | end if; |
1384 | ||
2368f04e MH |
1385 | pragma Assert (Vet (Position), "bad Position cursor in Splice"); |
1386 | ||
8704d4b3 MH |
1387 | if Position.Node = Before.Node |
1388 | or else Position.Node.Next = Before.Node | |
4c2d6a70 AC |
1389 | then |
1390 | return; | |
1391 | end if; | |
1392 | ||
7cdc672b | 1393 | pragma Assert (Container.Length >= 2); |
8704d4b3 | 1394 | |
7cdc672b | 1395 | if Container.Busy > 0 then |
3837bc7f MH |
1396 | raise Program_Error with |
1397 | "attempt to tamper with elements (list is busy)"; | |
8704d4b3 | 1398 | end if; |
4c2d6a70 AC |
1399 | |
1400 | if Before.Node = null then | |
7cdc672b | 1401 | pragma Assert (Position.Node /= Container.Last); |
4c2d6a70 | 1402 | |
7cdc672b MH |
1403 | if Position.Node = Container.First then |
1404 | Container.First := Position.Node.Next; | |
1405 | Container.First.Prev := null; | |
4c2d6a70 | 1406 | else |
8704d4b3 MH |
1407 | Position.Node.Prev.Next := Position.Node.Next; |
1408 | Position.Node.Next.Prev := Position.Node.Prev; | |
4c2d6a70 AC |
1409 | end if; |
1410 | ||
7cdc672b MH |
1411 | Container.Last.Next := Position.Node; |
1412 | Position.Node.Prev := Container.Last; | |
4c2d6a70 | 1413 | |
7cdc672b MH |
1414 | Container.Last := Position.Node; |
1415 | Container.Last.Next := null; | |
4c2d6a70 AC |
1416 | |
1417 | return; | |
1418 | end if; | |
1419 | ||
7cdc672b MH |
1420 | if Before.Node = Container.First then |
1421 | pragma Assert (Position.Node /= Container.First); | |
4c2d6a70 | 1422 | |
7cdc672b MH |
1423 | if Position.Node = Container.Last then |
1424 | Container.Last := Position.Node.Prev; | |
1425 | Container.Last.Next := null; | |
4c2d6a70 | 1426 | else |
8704d4b3 MH |
1427 | Position.Node.Prev.Next := Position.Node.Next; |
1428 | Position.Node.Next.Prev := Position.Node.Prev; | |
4c2d6a70 AC |
1429 | end if; |
1430 | ||
7cdc672b MH |
1431 | Container.First.Prev := Position.Node; |
1432 | Position.Node.Next := Container.First; | |
4c2d6a70 | 1433 | |
7cdc672b MH |
1434 | Container.First := Position.Node; |
1435 | Container.First.Prev := null; | |
4c2d6a70 AC |
1436 | |
1437 | return; | |
1438 | end if; | |
1439 | ||
7cdc672b MH |
1440 | if Position.Node = Container.First then |
1441 | Container.First := Position.Node.Next; | |
1442 | Container.First.Prev := null; | |
4c2d6a70 | 1443 | |
7cdc672b MH |
1444 | elsif Position.Node = Container.Last then |
1445 | Container.Last := Position.Node.Prev; | |
1446 | Container.Last.Next := null; | |
4c2d6a70 AC |
1447 | |
1448 | else | |
8704d4b3 MH |
1449 | Position.Node.Prev.Next := Position.Node.Next; |
1450 | Position.Node.Next.Prev := Position.Node.Prev; | |
4c2d6a70 AC |
1451 | end if; |
1452 | ||
8704d4b3 MH |
1453 | Before.Node.Prev.Next := Position.Node; |
1454 | Position.Node.Prev := Before.Node.Prev; | |
1455 | ||
1456 | Before.Node.Prev := Position.Node; | |
1457 | Position.Node.Next := Before.Node; | |
4c2d6a70 | 1458 | |
7cdc672b MH |
1459 | pragma Assert (Container.First.Prev = null); |
1460 | pragma Assert (Container.Last.Next = null); | |
4c2d6a70 AC |
1461 | end Splice; |
1462 | ||
1463 | procedure Splice | |
1464 | (Target : in out List; | |
1465 | Before : Cursor; | |
1466 | Source : in out List; | |
8704d4b3 | 1467 | Position : in out Cursor) |
4c2d6a70 | 1468 | is |
4c2d6a70 AC |
1469 | begin |
1470 | if Target'Address = Source'Address then | |
1471 | Splice (Target, Before, Position); | |
1472 | return; | |
1473 | end if; | |
1474 | ||
2368f04e MH |
1475 | if Before.Container /= null then |
1476 | if Before.Container /= Target'Unrestricted_Access then | |
3837bc7f MH |
1477 | raise Program_Error with |
1478 | "Before cursor designates wrong container"; | |
2368f04e | 1479 | end if; |
8704d4b3 | 1480 | |
2368f04e MH |
1481 | if Before.Node = null |
1482 | or else Before.Node.Element = null | |
1483 | then | |
3837bc7f MH |
1484 | raise Program_Error with |
1485 | "Before cursor has no element"; | |
2368f04e MH |
1486 | end if; |
1487 | ||
1488 | pragma Assert (Vet (Before), "bad Before cursor in Splice"); | |
4c2d6a70 AC |
1489 | end if; |
1490 | ||
8704d4b3 | 1491 | if Position.Node = null then |
3837bc7f | 1492 | raise Constraint_Error with "Position cursor has no element"; |
4c2d6a70 AC |
1493 | end if; |
1494 | ||
2368f04e | 1495 | if Position.Node.Element = null then |
3837bc7f MH |
1496 | raise Program_Error with |
1497 | "Position cursor has no element"; | |
2368f04e MH |
1498 | end if; |
1499 | ||
ba355842 | 1500 | if Position.Container /= Source'Unrestricted_Access then |
3837bc7f MH |
1501 | raise Program_Error with |
1502 | "Position cursor designates wrong container"; | |
4c2d6a70 AC |
1503 | end if; |
1504 | ||
2368f04e MH |
1505 | pragma Assert (Vet (Position), "bad Position cursor in Splice"); |
1506 | ||
8704d4b3 | 1507 | if Target.Length = Count_Type'Last then |
3837bc7f | 1508 | raise Constraint_Error with "Target is full"; |
8704d4b3 MH |
1509 | end if; |
1510 | ||
3837bc7f MH |
1511 | if Target.Busy > 0 then |
1512 | raise Program_Error with | |
1513 | "attempt to tamper with elements of Target (list is busy)"; | |
1514 | end if; | |
1515 | ||
1516 | if Source.Busy > 0 then | |
1517 | raise Program_Error with | |
1518 | "attempt to tamper with elements of Source (list is busy)"; | |
8704d4b3 MH |
1519 | end if; |
1520 | ||
1521 | if Position.Node = Source.First then | |
1522 | Source.First := Position.Node.Next; | |
4c2d6a70 | 1523 | |
8704d4b3 | 1524 | if Position.Node = Source.Last then |
4c2d6a70 AC |
1525 | pragma Assert (Source.First = null); |
1526 | pragma Assert (Source.Length = 1); | |
1527 | Source.Last := null; | |
ba355842 MH |
1528 | |
1529 | else | |
1530 | Source.First.Prev := null; | |
4c2d6a70 AC |
1531 | end if; |
1532 | ||
8704d4b3 MH |
1533 | elsif Position.Node = Source.Last then |
1534 | pragma Assert (Source.Length >= 2); | |
1535 | Source.Last := Position.Node.Prev; | |
4c2d6a70 AC |
1536 | Source.Last.Next := null; |
1537 | ||
1538 | else | |
8704d4b3 MH |
1539 | pragma Assert (Source.Length >= 3); |
1540 | Position.Node.Prev.Next := Position.Node.Next; | |
1541 | Position.Node.Next.Prev := Position.Node.Prev; | |
4c2d6a70 AC |
1542 | end if; |
1543 | ||
1544 | if Target.Length = 0 then | |
1545 | pragma Assert (Before = No_Element); | |
1546 | pragma Assert (Target.First = null); | |
1547 | pragma Assert (Target.Last = null); | |
1548 | ||
8704d4b3 MH |
1549 | Target.First := Position.Node; |
1550 | Target.Last := Position.Node; | |
1551 | ||
1552 | Target.First.Prev := null; | |
1553 | Target.Last.Next := null; | |
4c2d6a70 AC |
1554 | |
1555 | elsif Before.Node = null then | |
8704d4b3 MH |
1556 | pragma Assert (Target.Last.Next = null); |
1557 | Target.Last.Next := Position.Node; | |
1558 | Position.Node.Prev := Target.Last; | |
4c2d6a70 | 1559 | |
8704d4b3 | 1560 | Target.Last := Position.Node; |
4c2d6a70 AC |
1561 | Target.Last.Next := null; |
1562 | ||
1563 | elsif Before.Node = Target.First then | |
8704d4b3 MH |
1564 | pragma Assert (Target.First.Prev = null); |
1565 | Target.First.Prev := Position.Node; | |
1566 | Position.Node.Next := Target.First; | |
4c2d6a70 | 1567 | |
8704d4b3 | 1568 | Target.First := Position.Node; |
4c2d6a70 AC |
1569 | Target.First.Prev := null; |
1570 | ||
1571 | else | |
8704d4b3 MH |
1572 | pragma Assert (Target.Length >= 2); |
1573 | Before.Node.Prev.Next := Position.Node; | |
1574 | Position.Node.Prev := Before.Node.Prev; | |
4c2d6a70 | 1575 | |
8704d4b3 MH |
1576 | Before.Node.Prev := Position.Node; |
1577 | Position.Node.Next := Before.Node; | |
4c2d6a70 AC |
1578 | end if; |
1579 | ||
1580 | Target.Length := Target.Length + 1; | |
1581 | Source.Length := Source.Length - 1; | |
8704d4b3 MH |
1582 | |
1583 | Position.Container := Target'Unchecked_Access; | |
4c2d6a70 AC |
1584 | end Splice; |
1585 | ||
1586 | ---------- | |
1587 | -- Swap -- | |
1588 | ---------- | |
1589 | ||
2368f04e MH |
1590 | procedure Swap |
1591 | (Container : in out List; | |
1592 | I, J : Cursor) | |
1593 | is | |
8704d4b3 | 1594 | begin |
3837bc7f MH |
1595 | if I.Node = null then |
1596 | raise Constraint_Error with "I cursor has no element"; | |
8704d4b3 | 1597 | end if; |
4c2d6a70 | 1598 | |
3837bc7f MH |
1599 | if J.Node = null then |
1600 | raise Constraint_Error with "J cursor has no element"; | |
1601 | end if; | |
1602 | ||
1603 | if I.Container /= Container'Unchecked_Access then | |
1604 | raise Program_Error with "I cursor designates wrong container"; | |
1605 | end if; | |
1606 | ||
1607 | if J.Container /= Container'Unchecked_Access then | |
1608 | raise Program_Error with "J cursor designates wrong container"; | |
8704d4b3 | 1609 | end if; |
4c2d6a70 | 1610 | |
ba355842 MH |
1611 | if I.Node = J.Node then |
1612 | return; | |
1613 | end if; | |
4c2d6a70 | 1614 | |
2368f04e | 1615 | if Container.Lock > 0 then |
3837bc7f MH |
1616 | raise Program_Error with |
1617 | "attempt to tamper with cursors (list is locked)"; | |
ba355842 | 1618 | end if; |
8704d4b3 | 1619 | |
2368f04e MH |
1620 | pragma Assert (Vet (I), "bad I cursor in Swap"); |
1621 | pragma Assert (Vet (J), "bad J cursor in Swap"); | |
1622 | ||
ba355842 MH |
1623 | declare |
1624 | EI_Copy : constant Element_Access := I.Node.Element; | |
2368f04e | 1625 | |
ba355842 MH |
1626 | begin |
1627 | I.Node.Element := J.Node.Element; | |
1628 | J.Node.Element := EI_Copy; | |
8704d4b3 | 1629 | end; |
4c2d6a70 AC |
1630 | end Swap; |
1631 | ||
1632 | ---------------- | |
1633 | -- Swap_Links -- | |
1634 | ---------------- | |
1635 | ||
1636 | procedure Swap_Links | |
1637 | (Container : in out List; | |
1638 | I, J : Cursor) | |
1639 | is | |
1640 | begin | |
3837bc7f MH |
1641 | if I.Node = null then |
1642 | raise Constraint_Error with "I cursor has no element"; | |
4c2d6a70 AC |
1643 | end if; |
1644 | ||
3837bc7f MH |
1645 | if J.Node = null then |
1646 | raise Constraint_Error with "J cursor has no element"; | |
1647 | end if; | |
1648 | ||
1649 | if I.Container /= Container'Unrestricted_Access then | |
1650 | raise Program_Error with "I cursor designates wrong container"; | |
1651 | end if; | |
1652 | ||
1653 | if J.Container /= Container'Unrestricted_Access then | |
1654 | raise Program_Error with "J cursor designates wrong container"; | |
4c2d6a70 AC |
1655 | end if; |
1656 | ||
4c2d6a70 AC |
1657 | if I.Node = J.Node then |
1658 | return; | |
1659 | end if; | |
1660 | ||
8704d4b3 | 1661 | if Container.Busy > 0 then |
3837bc7f MH |
1662 | raise Program_Error with |
1663 | "attempt to tamper with elements (list is busy)"; | |
8704d4b3 | 1664 | end if; |
4c2d6a70 | 1665 | |
2368f04e MH |
1666 | pragma Assert (Vet (I), "bad I cursor in Swap_Links"); |
1667 | pragma Assert (Vet (J), "bad J cursor in Swap_Links"); | |
1668 | ||
4c2d6a70 AC |
1669 | declare |
1670 | I_Next : constant Cursor := Next (I); | |
1671 | ||
1672 | begin | |
1673 | if I_Next = J then | |
3837bc7f | 1674 | Splice (Container, Before => I, Position => J); |
4c2d6a70 AC |
1675 | |
1676 | else | |
1677 | declare | |
1678 | J_Next : constant Cursor := Next (J); | |
7cdc672b | 1679 | |
4c2d6a70 AC |
1680 | begin |
1681 | if J_Next = I then | |
3837bc7f | 1682 | Splice (Container, Before => J, Position => I); |
4c2d6a70 AC |
1683 | |
1684 | else | |
1685 | pragma Assert (Container.Length >= 3); | |
1686 | ||
3837bc7f MH |
1687 | Splice (Container, Before => I_Next, Position => J); |
1688 | Splice (Container, Before => J_Next, Position => I); | |
4c2d6a70 AC |
1689 | end if; |
1690 | end; | |
1691 | end if; | |
1692 | end; | |
8704d4b3 MH |
1693 | |
1694 | pragma Assert (Container.First.Prev = null); | |
1695 | pragma Assert (Container.Last.Next = null); | |
4c2d6a70 AC |
1696 | end Swap_Links; |
1697 | ||
1698 | -------------------- | |
1699 | -- Update_Element -- | |
1700 | -------------------- | |
1701 | ||
1702 | procedure Update_Element | |
2368f04e MH |
1703 | (Container : in out List; |
1704 | Position : Cursor; | |
1705 | Process : not null access procedure (Element : in out Element_Type)) | |
4c2d6a70 AC |
1706 | is |
1707 | begin | |
ba355842 | 1708 | if Position.Node = null then |
3837bc7f | 1709 | raise Constraint_Error with "Position cursor has no element"; |
ba355842 MH |
1710 | end if; |
1711 | ||
2368f04e | 1712 | if Position.Node.Element = null then |
3837bc7f MH |
1713 | raise Program_Error with |
1714 | "Position cursor has no element"; | |
2368f04e MH |
1715 | end if; |
1716 | ||
1717 | if Position.Container /= Container'Unchecked_Access then | |
3837bc7f MH |
1718 | raise Program_Error with |
1719 | "Position cursor designates wrong container"; | |
2368f04e MH |
1720 | end if; |
1721 | ||
1722 | pragma Assert (Vet (Position), "bad cursor in Update_Element"); | |
1723 | ||
ba355842 | 1724 | declare |
2368f04e MH |
1725 | B : Natural renames Container.Busy; |
1726 | L : Natural renames Container.Lock; | |
8704d4b3 MH |
1727 | |
1728 | begin | |
ba355842 MH |
1729 | B := B + 1; |
1730 | L := L + 1; | |
8704d4b3 | 1731 | |
ba355842 MH |
1732 | begin |
1733 | Process (Position.Node.Element.all); | |
1734 | exception | |
1735 | when others => | |
1736 | L := L - 1; | |
1737 | B := B - 1; | |
1738 | raise; | |
1739 | end; | |
1740 | ||
1741 | L := L - 1; | |
1742 | B := B - 1; | |
1743 | end; | |
4c2d6a70 AC |
1744 | end Update_Element; |
1745 | ||
ba355842 MH |
1746 | --------- |
1747 | -- Vet -- | |
1748 | --------- | |
1749 | ||
1750 | function Vet (Position : Cursor) return Boolean is | |
1751 | begin | |
1752 | if Position.Node = null then | |
1753 | return Position.Container = null; | |
1754 | end if; | |
1755 | ||
1756 | if Position.Container = null then | |
1757 | return False; | |
1758 | end if; | |
1759 | ||
1760 | if Position.Node.Next = Position.Node then | |
1761 | return False; | |
1762 | end if; | |
1763 | ||
1764 | if Position.Node.Prev = Position.Node then | |
1765 | return False; | |
1766 | end if; | |
1767 | ||
1768 | if Position.Node.Element = null then | |
1769 | return False; | |
1770 | end if; | |
1771 | ||
1772 | declare | |
1773 | L : List renames Position.Container.all; | |
1774 | begin | |
1775 | if L.Length = 0 then | |
1776 | return False; | |
1777 | end if; | |
1778 | ||
1779 | if L.First = null then | |
1780 | return False; | |
1781 | end if; | |
1782 | ||
1783 | if L.Last = null then | |
1784 | return False; | |
1785 | end if; | |
1786 | ||
1787 | if L.First.Prev /= null then | |
1788 | return False; | |
1789 | end if; | |
1790 | ||
1791 | if L.Last.Next /= null then | |
1792 | return False; | |
1793 | end if; | |
1794 | ||
1795 | if Position.Node.Prev = null | |
1796 | and then Position.Node /= L.First | |
1797 | then | |
1798 | return False; | |
1799 | end if; | |
1800 | ||
1801 | if Position.Node.Next = null | |
1802 | and then Position.Node /= L.Last | |
1803 | then | |
1804 | return False; | |
1805 | end if; | |
1806 | ||
1807 | if L.Length = 1 then | |
1808 | return L.First = L.Last; | |
1809 | end if; | |
1810 | ||
1811 | if L.First = L.Last then | |
1812 | return False; | |
1813 | end if; | |
1814 | ||
1815 | if L.First.Next = null then | |
1816 | return False; | |
1817 | end if; | |
1818 | ||
1819 | if L.Last.Prev = null then | |
1820 | return False; | |
1821 | end if; | |
1822 | ||
1823 | if L.First.Next.Prev /= L.First then | |
1824 | return False; | |
1825 | end if; | |
1826 | ||
1827 | if L.Last.Prev.Next /= L.Last then | |
1828 | return False; | |
1829 | end if; | |
1830 | ||
1831 | if L.Length = 2 then | |
1832 | if L.First.Next /= L.Last then | |
1833 | return False; | |
1834 | end if; | |
1835 | ||
1836 | if L.Last.Prev /= L.First then | |
1837 | return False; | |
1838 | end if; | |
1839 | ||
1840 | return True; | |
1841 | end if; | |
1842 | ||
1843 | if L.First.Next = L.Last then | |
1844 | return False; | |
1845 | end if; | |
1846 | ||
1847 | if L.Last.Prev = L.First then | |
1848 | return False; | |
1849 | end if; | |
1850 | ||
1851 | if Position.Node = L.First then | |
1852 | return True; | |
1853 | end if; | |
1854 | ||
1855 | if Position.Node = L.Last then | |
1856 | return True; | |
1857 | end if; | |
1858 | ||
1859 | if Position.Node.Next = null then | |
1860 | return False; | |
1861 | end if; | |
1862 | ||
1863 | if Position.Node.Prev = null then | |
1864 | return False; | |
1865 | end if; | |
1866 | ||
1867 | if Position.Node.Next.Prev /= Position.Node then | |
1868 | return False; | |
1869 | end if; | |
1870 | ||
1871 | if Position.Node.Prev.Next /= Position.Node then | |
1872 | return False; | |
1873 | end if; | |
1874 | ||
1875 | if L.Length = 3 then | |
1876 | if L.First.Next /= Position.Node then | |
1877 | return False; | |
1878 | end if; | |
1879 | ||
1880 | if L.Last.Prev /= Position.Node then | |
1881 | return False; | |
1882 | end if; | |
1883 | end if; | |
1884 | ||
1885 | return True; | |
1886 | end; | |
1887 | end Vet; | |
1888 | ||
4c2d6a70 AC |
1889 | ----------- |
1890 | -- Write -- | |
1891 | ----------- | |
1892 | ||
1893 | procedure Write | |
3837bc7f | 1894 | (Stream : not null access Root_Stream_Type'Class; |
4c2d6a70 AC |
1895 | Item : List) |
1896 | is | |
1897 | Node : Node_Access := Item.First; | |
ba355842 | 1898 | |
4c2d6a70 AC |
1899 | begin |
1900 | Count_Type'Base'Write (Stream, Item.Length); | |
ba355842 | 1901 | |
4c2d6a70 | 1902 | while Node /= null loop |
3837bc7f | 1903 | Element_Type'Output (Stream, Node.Element.all); |
4c2d6a70 AC |
1904 | Node := Node.Next; |
1905 | end loop; | |
1906 | end Write; | |
1907 | ||
2368f04e | 1908 | procedure Write |
3837bc7f | 1909 | (Stream : not null access Root_Stream_Type'Class; |
2368f04e MH |
1910 | Item : Cursor) |
1911 | is | |
1912 | begin | |
3837bc7f | 1913 | raise Program_Error with "attempt to stream list cursor"; |
2368f04e MH |
1914 | end Write; |
1915 | ||
4c2d6a70 | 1916 | end Ada.Containers.Indefinite_Doubly_Linked_Lists; |