]>
Commit | Line | Data |
---|---|---|
992ec8bc | 1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT LIBRARY COMPONENTS -- | |
4 | -- -- | |
5 | -- ADA.CONTAINERS.FORMAL_DOUBLY_LINKED_LISTS -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
9 | -- Copyright (C) 2010, Free Software Foundation, Inc. -- | |
10 | -- -- | |
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- -- | |
13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- | |
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 -- | |
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/>. -- | |
26 | ------------------------------------------------------------------------------ | |
27 | ||
28 | with System; use type System.Address; | |
29 | ||
30 | package body Ada.Containers.Formal_Doubly_Linked_Lists is | |
31 | ||
32 | ----------------------- | |
33 | -- Local Subprograms -- | |
34 | ----------------------- | |
35 | ||
36 | procedure Allocate | |
37 | (Container : in out List; | |
38 | New_Item : Element_Type; | |
39 | New_Node : out Count_Type); | |
40 | ||
41 | procedure Allocate | |
42 | (Container : in out List; | |
43 | New_Node : out Count_Type); | |
44 | ||
45 | function Copy | |
46 | (Source : Plain_List; | |
47 | Capacity : Count_Type := 0) return PList_Access; | |
48 | ||
49 | function Find_Between | |
50 | (Container : Plain_List; | |
51 | Item : Element_Type; | |
52 | From : Count_Type; | |
53 | To : Count_Type; | |
54 | Bg : Count_Type) return Cursor; | |
55 | ||
56 | function Element_Unchecked | |
57 | (Container : List; | |
58 | Position : Count_Type) return Element_Type; | |
59 | ||
60 | procedure Free | |
61 | (Container : in out Plain_List; | |
62 | X : Count_Type); | |
63 | ||
64 | function Has_Element_Base | |
65 | (Container : Plain_List; | |
66 | Position : Cursor) return Boolean; | |
67 | ||
68 | procedure Insert_Internal | |
69 | (Container : in out List; | |
70 | Before : Count_Type; | |
71 | New_Node : Count_Type); | |
72 | ||
73 | procedure Iterate_Between | |
74 | (Container : List; | |
75 | From : Count_Type; | |
76 | To : Count_Type; | |
77 | Process : | |
78 | not null access procedure (Container : List; Position : Cursor)); | |
79 | ||
80 | function Next_Unchecked | |
81 | (Container : List; | |
82 | Position : Count_Type) return Count_Type; | |
83 | ||
84 | procedure Query_Element_Plain | |
85 | (Container : Plain_List; Position : Cursor; | |
86 | Process : not null access procedure (Element : Element_Type)); | |
87 | ||
88 | function Reverse_Find_Between | |
89 | (Container : Plain_List; | |
90 | Item : Element_Type; | |
91 | From : Count_Type; | |
92 | To : Count_Type) return Cursor; | |
93 | ||
94 | procedure Reverse_Iterate_Between | |
95 | (Container : List; | |
96 | From : Count_Type; | |
97 | To : Count_Type; | |
98 | Process : | |
99 | not null access procedure (Container : List; Position : Cursor)); | |
100 | ||
101 | function Vet (L : List; Position : Cursor) return Boolean; | |
102 | ||
103 | procedure Write_Between | |
104 | (Stream : not null access Root_Stream_Type'Class; | |
105 | Item : Plain_List; | |
106 | Length : Count_Type; | |
107 | From : Count_Type; | |
108 | To : Count_Type); | |
109 | ||
110 | --------- | |
111 | -- "=" -- | |
112 | --------- | |
113 | ||
114 | function "=" (Left, Right : List) return Boolean is | |
115 | LI, RI : Count_Type; | |
116 | ||
117 | begin | |
118 | if Left'Address = Right'Address then | |
119 | return True; | |
120 | end if; | |
121 | ||
122 | if Left.Length /= Right.Length then | |
123 | return False; | |
124 | end if; | |
125 | ||
126 | LI := Left.First; | |
127 | RI := Right.First; | |
128 | while LI /= 0 loop | |
129 | if Element_Unchecked (Left, LI) /= Element_Unchecked (Right, LI) then | |
130 | return False; | |
131 | end if; | |
132 | ||
133 | LI := Next_Unchecked (Left, LI); | |
134 | RI := Next_Unchecked (Right, RI); | |
135 | end loop; | |
136 | ||
137 | return True; | |
138 | end "="; | |
139 | ||
140 | -------------- | |
141 | -- Allocate -- | |
142 | -------------- | |
143 | ||
144 | procedure Allocate | |
145 | (Container : in out List; | |
146 | New_Item : Element_Type; | |
147 | New_Node : out Count_Type) | |
148 | is | |
149 | ContainerP : Plain_List renames Container.Plain.all; | |
150 | begin | |
151 | if Container.K /= Plain then | |
152 | raise Program_Error with "cannot modify part of container"; | |
153 | end if; | |
154 | ||
155 | declare | |
156 | N : Node_Array renames Container.Plain.all.Nodes; | |
157 | ||
158 | begin | |
159 | if ContainerP.Free >= 0 then | |
160 | New_Node := ContainerP.Free; | |
161 | N (New_Node).Element := New_Item; | |
162 | ContainerP.Free := N (New_Node).Next; | |
163 | ||
164 | else | |
165 | New_Node := abs ContainerP.Free; | |
166 | N (New_Node).Element := New_Item; | |
167 | ContainerP.Free := ContainerP.Free - 1; | |
168 | end if; | |
169 | end; | |
170 | end Allocate; | |
171 | ||
172 | procedure Allocate | |
173 | (Container : in out List; | |
174 | New_Node : out Count_Type) | |
175 | is | |
176 | ContainerP : Plain_List renames Container.Plain.all; | |
177 | begin | |
178 | if Container.K /= Plain then | |
179 | raise Program_Error with "cannot modify part of container"; | |
180 | end if; | |
181 | ||
182 | declare | |
183 | N : Node_Array renames ContainerP.Nodes; | |
184 | ||
185 | begin | |
186 | if ContainerP.Free >= 0 then | |
187 | New_Node := ContainerP.Free; | |
188 | ContainerP.Free := N (New_Node).Next; | |
189 | ||
190 | else | |
191 | New_Node := abs ContainerP.Free; | |
192 | ContainerP.Free := ContainerP.Free - 1; | |
193 | end if; | |
194 | end; | |
195 | end Allocate; | |
196 | ||
197 | ------------ | |
198 | -- Append -- | |
199 | ------------ | |
200 | ||
201 | procedure Append | |
202 | (Container : in out List; | |
203 | New_Item : Element_Type; | |
204 | Count : Count_Type := 1) | |
205 | is | |
206 | begin | |
207 | Insert (Container, No_Element, New_Item, Count); | |
208 | end Append; | |
209 | ||
210 | ------------ | |
211 | -- Assign -- | |
212 | ------------ | |
213 | ||
214 | procedure Assign (Target : in out List; Source : List) is | |
215 | begin | |
216 | if Target.K /= Plain or Source.K /= Plain then | |
217 | raise Program_Error with "cannot modify part of container"; | |
218 | end if; | |
219 | ||
220 | declare | |
221 | N : Node_Array renames Source.Plain.Nodes; | |
222 | J : Count_Type; | |
223 | ||
224 | begin | |
225 | if Target'Address = Source'Address then | |
226 | return; | |
227 | end if; | |
228 | ||
229 | if Target.Capacity < Source.Length then | |
230 | raise Constraint_Error with -- ??? | |
231 | "Source length exceeds Target capacity"; | |
232 | end if; | |
233 | ||
234 | Clear (Target); | |
235 | ||
236 | J := Source.First; | |
237 | while J /= 0 loop | |
238 | Append (Target, N (J).Element); | |
239 | J := N (J).Next; | |
240 | end loop; | |
241 | end; | |
242 | end Assign; | |
243 | ||
244 | ----------- | |
245 | -- Clear -- | |
246 | ----------- | |
247 | ||
248 | procedure Clear (Container : in out List) is | |
249 | begin | |
250 | if Container.K /= Plain then | |
251 | raise Constraint_Error; | |
252 | end if; | |
253 | ||
254 | declare | |
255 | N : Node_Array renames Container.Plain.Nodes; | |
256 | X : Count_Type; | |
257 | ||
258 | begin | |
259 | if Container.Length = 0 then | |
260 | pragma Assert (Container.First = 0); | |
261 | pragma Assert (Container.Last = 0); | |
262 | pragma Assert (Container.Plain.Busy = 0); | |
263 | pragma Assert (Container.Plain.Lock = 0); | |
264 | return; | |
265 | end if; | |
266 | ||
267 | pragma Assert (Container.First >= 1); | |
268 | pragma Assert (Container.Last >= 1); | |
269 | pragma Assert (N (Container.First).Prev = 0); | |
270 | pragma Assert (N (Container.Last).Next = 0); | |
271 | ||
272 | if Container.Plain.Busy > 0 then | |
273 | raise Program_Error with | |
274 | "attempt to tamper with elements (list is busy)"; | |
275 | end if; | |
276 | ||
277 | while Container.Length > 1 loop | |
278 | X := Container.First; | |
279 | ||
280 | Container.First := N (X).Next; | |
281 | N (Container.First).Prev := 0; | |
282 | ||
283 | Container.Length := Container.Length - 1; | |
284 | ||
285 | Free (Container.Plain.all, X); | |
286 | end loop; | |
287 | ||
288 | X := Container.First; | |
289 | ||
290 | Container.First := 0; | |
291 | Container.Last := 0; | |
292 | Container.Length := 0; | |
293 | ||
294 | Free (Container.Plain.all, X); | |
295 | end; | |
296 | end Clear; | |
297 | ||
298 | -------------- | |
299 | -- Contains -- | |
300 | -------------- | |
301 | ||
302 | function Contains | |
303 | (Container : List; | |
304 | Item : Element_Type) return Boolean | |
305 | is | |
306 | begin | |
307 | return Find (Container, Item) /= No_Element; | |
308 | end Contains; | |
309 | ||
310 | ---------- | |
311 | -- Copy -- | |
312 | ---------- | |
313 | ||
314 | function Copy | |
315 | (Source : Plain_List; | |
316 | Capacity : Count_Type := 0) return PList_Access | |
317 | is | |
318 | C : constant Count_Type := Count_Type'Max (Source.Capacity, Capacity); | |
319 | P : PList_Access; | |
320 | N : Count_Type := 1; | |
321 | begin | |
322 | P := new Plain_List (C); | |
323 | while N <= Source.Capacity loop | |
324 | P.Nodes (N).Prev := Source.Nodes (N).Prev; | |
325 | P.Nodes (N).Next := Source.Nodes (N).Next; | |
326 | P.Nodes (N).Element := Source.Nodes (N).Element; | |
327 | N := N + 1; | |
328 | end loop; | |
329 | P.Free := Source.Free; | |
330 | if P.Free >= 0 then | |
331 | N := Source.Capacity + 1; | |
332 | while N <= C loop | |
333 | Free (P.all, N); | |
334 | N := N + 1; | |
335 | end loop; | |
336 | end if; | |
337 | return P; | |
338 | end Copy; | |
339 | ||
340 | function Copy | |
341 | (Source : List; | |
342 | Capacity : Count_Type := 0) return List | |
343 | is | |
344 | Cap : constant Count_Type := Count_Type'Max (Source.Capacity, Capacity); | |
345 | begin | |
346 | case Source.K is | |
347 | when Plain => | |
348 | return (Capacity => Cap, | |
349 | Length => Source.Length, | |
350 | Plain => Copy (Source.Plain.all, Cap), | |
351 | First => Source.First, | |
352 | Last => Source.Last, | |
353 | others => <>); | |
354 | when Part => | |
355 | declare | |
356 | Target : List (Capacity => Cap); | |
357 | C : Cursor; | |
358 | P : Cursor; | |
359 | begin | |
360 | Target := (Capacity => Cap, | |
361 | Length => Source.Part.LLength, | |
362 | Plain => Copy (Source.Plain.all, Cap), | |
363 | First => Source.Part.LFirst, | |
364 | Last => Source.Part.LLast, | |
365 | others => <>); | |
366 | C := (Node => Target.First); | |
367 | while C.Node /= Source.First loop | |
368 | P := Next (Target, C); | |
369 | Delete (Container => Target, Position => C); | |
370 | C := P; | |
371 | end loop; | |
372 | if Source.Last /= 0 then | |
373 | C := (Node => Source.Plain.all.Nodes (Source.Last).Next); | |
374 | while C.Node /= 0 loop | |
375 | P := Next (Target, C); | |
376 | Delete (Container => Target, Position => C); | |
377 | C := P; | |
378 | end loop; | |
379 | end if; | |
380 | return Target; | |
381 | end; | |
382 | end case; | |
383 | end Copy; | |
384 | ||
385 | ------------ | |
386 | -- Delete -- | |
387 | ------------ | |
388 | ||
389 | procedure Delete | |
390 | (Container : in out List; | |
391 | Position : in out Cursor; | |
392 | Count : Count_Type := 1) | |
393 | is | |
394 | begin | |
395 | if Container.K /= Plain then | |
396 | raise Program_Error with "cannot modify part of container"; | |
397 | end if; | |
398 | ||
399 | declare | |
400 | N : Node_Array renames Container.Plain.Nodes; | |
401 | X : Count_Type; | |
402 | ||
403 | begin | |
404 | if not Has_Element (Container => Container, | |
405 | Position => Position) then | |
406 | raise Constraint_Error with | |
407 | "Position cursor has no element"; | |
408 | end if; | |
409 | ||
410 | pragma Assert (Vet (Container, Position), "bad cursor in Delete"); | |
411 | pragma Assert (Container.First >= 1); | |
412 | pragma Assert (Container.Last >= 1); | |
413 | pragma Assert (N (Container.First).Prev = 0); | |
414 | pragma Assert (N (Container.Last).Next = 0); | |
415 | ||
416 | if Position.Node = Container.First then | |
417 | Delete_First (Container, Count); | |
418 | Position := No_Element; | |
419 | return; | |
420 | end if; | |
421 | ||
422 | if Count = 0 then | |
423 | Position := No_Element; | |
424 | return; | |
425 | end if; | |
426 | ||
427 | if Container.Plain.Busy > 0 then | |
428 | raise Program_Error with | |
429 | "attempt to tamper with elements (list is busy)"; | |
430 | end if; | |
431 | ||
432 | for Index in 1 .. Count loop | |
433 | pragma Assert (Container.Length >= 2); | |
434 | ||
435 | X := Position.Node; | |
436 | Container.Length := Container.Length - 1; | |
437 | ||
438 | if X = Container.Last then | |
439 | Position := No_Element; | |
440 | ||
441 | Container.Last := N (X).Prev; | |
442 | N (Container.Last).Next := 0; | |
443 | ||
444 | Free (Container.Plain.all, X); | |
445 | return; | |
446 | end if; | |
447 | ||
448 | Position.Node := N (X).Next; | |
449 | pragma Assert (N (Position.Node).Prev >= 0); | |
450 | ||
451 | N (N (X).Next).Prev := N (X).Prev; | |
452 | N (N (X).Prev).Next := N (X).Next; | |
453 | ||
454 | Free (Container.Plain.all, X); | |
455 | end loop; | |
456 | Position := No_Element; | |
457 | end; | |
458 | end Delete; | |
459 | ||
460 | ------------------ | |
461 | -- Delete_First -- | |
462 | ------------------ | |
463 | ||
464 | procedure Delete_First | |
465 | (Container : in out List; | |
466 | Count : Count_Type := 1) | |
467 | is | |
468 | begin | |
469 | if Container.K /= Plain then | |
470 | raise Program_Error with "cannot modify part of container"; | |
471 | end if; | |
472 | ||
473 | declare | |
474 | N : Node_Array renames Container.Plain.Nodes; | |
475 | X : Count_Type; | |
476 | ||
477 | begin | |
478 | if Count >= Container.Length then | |
479 | Clear (Container); | |
480 | return; | |
481 | end if; | |
482 | ||
483 | if Count = 0 then | |
484 | return; | |
485 | end if; | |
486 | ||
487 | if Container.Plain.Busy > 0 then | |
488 | raise Program_Error with | |
489 | "attempt to tamper with elements (list is busy)"; | |
490 | end if; | |
491 | ||
492 | for I in 1 .. Count loop | |
493 | X := Container.First; | |
494 | pragma Assert (N (N (X).Next).Prev = Container.First); | |
495 | ||
496 | Container.First := N (X).Next; | |
497 | N (Container.First).Prev := 0; | |
498 | ||
499 | Container.Length := Container.Length - 1; | |
500 | ||
501 | Free (Container.Plain.all, X); | |
502 | end loop; | |
503 | end; | |
504 | end Delete_First; | |
505 | ||
506 | ----------------- | |
507 | -- Delete_Last -- | |
508 | ----------------- | |
509 | ||
510 | procedure Delete_Last | |
511 | (Container : in out List; | |
512 | Count : Count_Type := 1) | |
513 | is | |
514 | begin | |
515 | if Container.K /= Plain then | |
516 | raise Program_Error with "cannot modify part of container"; | |
517 | end if; | |
518 | ||
519 | declare | |
520 | N : Node_Array renames Container.Plain.Nodes; | |
521 | X : Count_Type; | |
522 | ||
523 | begin | |
524 | if Count >= Container.Length then | |
525 | Clear (Container); | |
526 | return; | |
527 | end if; | |
528 | ||
529 | if Count = 0 then | |
530 | return; | |
531 | end if; | |
532 | ||
533 | if Container.Plain.Busy > 0 then | |
534 | raise Program_Error with | |
535 | "attempt to tamper with elements (list is busy)"; | |
536 | end if; | |
537 | ||
538 | for I in 1 .. Count loop | |
539 | X := Container.Last; | |
540 | pragma Assert (N (N (X).Prev).Next = Container.Last); | |
541 | ||
542 | Container.Last := N (X).Prev; | |
543 | N (Container.Last).Next := 0; | |
544 | ||
545 | Container.Length := Container.Length - 1; | |
546 | ||
547 | Free (Container.Plain.all, X); | |
548 | end loop; | |
549 | end; | |
550 | end Delete_Last; | |
551 | ||
552 | ------------- | |
553 | -- Element -- | |
554 | ------------- | |
555 | ||
556 | function Element_Unchecked | |
557 | (Container : List; | |
558 | Position : Count_Type) return Element_Type is | |
559 | begin | |
560 | case Container.K is | |
561 | when Plain => | |
562 | return Container.Plain.Nodes (Position).Element; | |
563 | when others => | |
564 | return Container.Plain.all.Nodes (Position).Element; | |
565 | end case; | |
566 | end Element_Unchecked; | |
567 | ||
568 | function Element | |
569 | (Container : List; | |
570 | Position : Cursor) return Element_Type is | |
571 | begin | |
572 | if not Has_Element (Container => Container, Position => Position) then | |
573 | raise Constraint_Error with | |
574 | "Position cursor has no element"; | |
575 | end if; | |
576 | ||
577 | return Element_Unchecked (Container => Container, | |
578 | Position => Position.Node); | |
579 | end Element; | |
580 | ||
581 | ---------- | |
582 | -- Find -- | |
583 | ---------- | |
584 | ||
585 | function Find_Between | |
586 | (Container : Plain_List; | |
587 | Item : Element_Type; | |
588 | From : Count_Type; | |
589 | To : Count_Type; | |
590 | Bg : Count_Type) return Cursor | |
591 | is | |
592 | Nodes : Node_Array renames Container.Nodes; | |
593 | Node : Count_Type := Bg; | |
594 | begin | |
595 | while Node /= From loop | |
596 | if Node = 0 or else Node = To then | |
597 | raise Constraint_Error with | |
598 | "Position cursor has no element"; | |
599 | end if; | |
600 | Node := Nodes (Node).Next; | |
601 | end loop; | |
602 | while Node /= Nodes (To).Next loop | |
603 | if Nodes (Node).Element = Item then | |
604 | return (Node => Node); | |
605 | end if; | |
606 | Node := Nodes (Node).Next; | |
607 | end loop; | |
608 | ||
609 | return No_Element; | |
610 | end Find_Between; | |
611 | ||
612 | function Find | |
613 | (Container : List; | |
614 | Item : Element_Type; | |
615 | Position : Cursor := No_Element) return Cursor | |
616 | is | |
617 | From : Count_Type := Position.Node; | |
618 | begin | |
619 | if From = 0 and Container.Length = 0 then | |
620 | return No_Element; | |
621 | end if; | |
622 | if From = 0 then | |
623 | From := Container.First; | |
624 | end if; | |
625 | if Position.Node /= 0 and then | |
626 | not Has_Element_Base (Container.Plain.all, Position) then | |
627 | raise Constraint_Error with | |
628 | "Position cursor has no element"; | |
629 | end if; | |
630 | return Find_Between (Container => Container.Plain.all, | |
631 | Item => Item, | |
632 | From => From, | |
633 | To => Container.Last, | |
634 | Bg => Container.First); | |
635 | end Find; | |
636 | ||
637 | ----------- | |
638 | -- First -- | |
639 | ----------- | |
640 | ||
641 | function First (Container : List) return Cursor is | |
642 | begin | |
643 | if Container.First = 0 then | |
644 | return No_Element; | |
645 | end if; | |
646 | return (Node => Container.First); | |
647 | end First; | |
648 | ||
649 | ------------------- | |
650 | -- First_Element -- | |
651 | ------------------- | |
652 | ||
653 | function First_Element (Container : List) return Element_Type is | |
654 | F : constant Count_Type := Container.First; | |
655 | begin | |
656 | if F = 0 then | |
657 | raise Constraint_Error with "list is empty"; | |
658 | else | |
659 | return Element_Unchecked (Container, F); | |
660 | end if; | |
661 | end First_Element; | |
662 | ||
663 | ---------- | |
664 | -- Free -- | |
665 | ---------- | |
666 | ||
667 | procedure Free | |
668 | (Container : in out Plain_List; | |
669 | X : Count_Type) | |
670 | is | |
671 | pragma Assert (X > 0); | |
672 | pragma Assert (X <= Container.Capacity); | |
673 | ||
674 | N : Node_Array renames Container.Nodes; | |
675 | ||
676 | begin | |
677 | N (X).Prev := -1; -- Node is deallocated (not on active list) | |
678 | ||
679 | if Container.Free >= 0 then | |
680 | N (X).Next := Container.Free; | |
681 | Container.Free := X; | |
682 | ||
683 | elsif X + 1 = abs Container.Free then | |
684 | N (X).Next := 0; -- Not strictly necessary, but marginally safer | |
685 | Container.Free := Container.Free + 1; | |
686 | ||
687 | else | |
688 | Container.Free := abs Container.Free; | |
689 | ||
690 | if Container.Free > Container.Capacity then | |
691 | Container.Free := 0; | |
692 | ||
693 | else | |
694 | for I in Container.Free .. Container.Capacity - 1 loop | |
695 | N (I).Next := I + 1; | |
696 | end loop; | |
697 | ||
698 | N (Container.Capacity).Next := 0; | |
699 | end if; | |
700 | ||
701 | N (X).Next := Container.Free; | |
702 | Container.Free := X; | |
703 | end if; | |
704 | end Free; | |
705 | ||
706 | --------------------- | |
707 | -- Generic_Sorting -- | |
708 | --------------------- | |
709 | ||
710 | package body Generic_Sorting is | |
711 | ||
712 | --------------- | |
713 | -- Is_Sorted -- | |
714 | --------------- | |
715 | ||
716 | function Is_Sorted (Container : List) return Boolean is | |
717 | Nodes : Node_Array renames Container.Plain.all.Nodes; | |
718 | Node : Count_Type := Container.First; | |
719 | begin | |
720 | for I in 2 .. Container.Length loop | |
721 | if Nodes (Nodes (Node).Next).Element < Nodes (Node).Element then | |
722 | return False; | |
723 | end if; | |
724 | ||
725 | Node := Nodes (Node).Next; | |
726 | end loop; | |
727 | ||
728 | return True; | |
729 | end Is_Sorted; | |
730 | ||
731 | ----------- | |
732 | -- Merge -- | |
733 | ----------- | |
734 | ||
735 | procedure Merge | |
736 | (Target : in out List; | |
737 | Source : in out List) | |
738 | is | |
739 | begin | |
740 | if Target.K /= Plain or Source.K /= Plain then | |
741 | raise Program_Error with "cannot modify part of container"; | |
742 | end if; | |
743 | ||
744 | declare | |
745 | LN : Node_Array renames Target.Plain.Nodes; | |
746 | RN : Node_Array renames Source.Plain.Nodes; | |
747 | LI : Cursor; | |
748 | RI : Cursor; | |
749 | ||
750 | begin | |
751 | if Target'Address = Source'Address then | |
752 | return; | |
753 | end if; | |
754 | ||
755 | if Target.Plain.Busy > 0 then | |
756 | raise Program_Error with | |
757 | "attempt to tamper with cursors of Target (list is busy)"; | |
758 | end if; | |
759 | ||
760 | if Source.Plain.Busy > 0 then | |
761 | raise Program_Error with | |
762 | "attempt to tamper with cursors of Source (list is busy)"; | |
763 | end if; | |
764 | ||
765 | LI := First (Target); | |
766 | RI := First (Source); | |
767 | while RI.Node /= 0 loop | |
768 | pragma Assert (RN (RI.Node).Next = 0 | |
769 | or else not (RN (RN (RI.Node).Next).Element < | |
770 | RN (RI.Node).Element)); | |
771 | ||
772 | if LI.Node = 0 then | |
773 | Splice (Target, No_Element, Source); | |
774 | return; | |
775 | end if; | |
776 | ||
777 | pragma Assert (LN (LI.Node).Next = 0 | |
778 | or else not (LN (LN (LI.Node).Next).Element < | |
779 | LN (LI.Node).Element)); | |
780 | ||
781 | if RN (RI.Node).Element < LN (LI.Node).Element then | |
782 | declare | |
783 | RJ : Cursor := RI; | |
784 | pragma Warnings (Off, RJ); | |
785 | begin | |
786 | RI.Node := RN (RI.Node).Next; | |
787 | Splice (Target, LI, Source, RJ); | |
788 | end; | |
789 | ||
790 | else | |
791 | LI.Node := LN (LI.Node).Next; | |
792 | end if; | |
793 | end loop; | |
794 | end; | |
795 | end Merge; | |
796 | ||
797 | ---------- | |
798 | -- Sort -- | |
799 | ---------- | |
800 | ||
801 | procedure Sort (Container : in out List) is | |
802 | begin | |
803 | if Container.K /= Plain then | |
804 | raise Program_Error with "cannot modify part of container"; | |
805 | end if; | |
806 | ||
807 | declare | |
808 | N : Node_Array renames Container.Plain.Nodes; | |
809 | ||
810 | procedure Partition (Pivot, Back : Count_Type); | |
811 | procedure Sort (Front, Back : Count_Type); | |
812 | ||
813 | --------------- | |
814 | -- Partition -- | |
815 | --------------- | |
816 | ||
817 | procedure Partition (Pivot, Back : Count_Type) is | |
818 | Node : Count_Type := N (Pivot).Next; | |
819 | ||
820 | begin | |
821 | while Node /= Back loop | |
822 | if N (Node).Element < N (Pivot).Element then | |
823 | declare | |
824 | Prev : constant Count_Type := N (Node).Prev; | |
825 | Next : constant Count_Type := N (Node).Next; | |
826 | ||
827 | begin | |
828 | N (Prev).Next := Next; | |
829 | ||
830 | if Next = 0 then | |
831 | Container.Last := Prev; | |
832 | else | |
833 | N (Next).Prev := Prev; | |
834 | end if; | |
835 | ||
836 | N (Node).Next := Pivot; | |
837 | N (Node).Prev := N (Pivot).Prev; | |
838 | ||
839 | N (Pivot).Prev := Node; | |
840 | ||
841 | if N (Node).Prev = 0 then | |
842 | Container.First := Node; | |
843 | else | |
844 | N (N (Node).Prev).Next := Node; | |
845 | end if; | |
846 | ||
847 | Node := Next; | |
848 | end; | |
849 | ||
850 | else | |
851 | Node := N (Node).Next; | |
852 | end if; | |
853 | end loop; | |
854 | end Partition; | |
855 | ||
856 | ---------- | |
857 | -- Sort -- | |
858 | ---------- | |
859 | ||
860 | procedure Sort (Front, Back : Count_Type) is | |
861 | Pivot : Count_Type; | |
862 | ||
863 | begin | |
864 | if Front = 0 then | |
865 | Pivot := Container.First; | |
866 | else | |
867 | Pivot := N (Front).Next; | |
868 | end if; | |
869 | ||
870 | if Pivot /= Back then | |
871 | Partition (Pivot, Back); | |
872 | Sort (Front, Pivot); | |
873 | Sort (Pivot, Back); | |
874 | end if; | |
875 | end Sort; | |
876 | ||
877 | -- Start of processing for Sort | |
878 | ||
879 | begin | |
880 | if Container.Length <= 1 then | |
881 | return; | |
882 | end if; | |
883 | ||
884 | pragma Assert (N (Container.First).Prev = 0); | |
885 | pragma Assert (N (Container.Last).Next = 0); | |
886 | ||
887 | if Container.Plain.Busy > 0 then | |
888 | raise Program_Error with | |
889 | "attempt to tamper with elements (list is busy)"; | |
890 | end if; | |
891 | ||
892 | Sort (Front => 0, Back => 0); | |
893 | ||
894 | pragma Assert (N (Container.First).Prev = 0); | |
895 | pragma Assert (N (Container.Last).Next = 0); | |
896 | end; | |
897 | end Sort; | |
898 | ||
899 | end Generic_Sorting; | |
900 | ||
901 | ----------------- | |
902 | -- Has_Element -- | |
903 | ----------------- | |
904 | ||
905 | function Has_Element_Base (Container : Plain_List; Position : Cursor) | |
906 | return Boolean | |
907 | is | |
908 | begin | |
909 | return Container.Nodes (Position.Node).Prev /= -1; | |
910 | end Has_Element_Base; | |
911 | ||
912 | function Has_Element (Container : List; Position : Cursor) return Boolean is | |
913 | begin | |
914 | if Position.Node = 0 then | |
915 | return False; | |
916 | end if; | |
917 | ||
918 | case Container.K is | |
919 | when Plain => | |
920 | return Container.Plain.Nodes (Position.Node).Prev /= -1; | |
921 | when Part => | |
922 | declare | |
923 | Current : Count_Type := Container.First; | |
924 | begin | |
925 | if Container.Plain.Nodes (Position.Node).Prev = -1 then | |
926 | return False; | |
927 | end if; | |
928 | while Current /= 0 loop | |
929 | if Current = Position.Node then | |
930 | return True; | |
931 | end if; | |
932 | Current := Next_Unchecked (Container, Current); | |
933 | end loop; | |
934 | return False; | |
935 | end; | |
936 | end case; | |
937 | end Has_Element; | |
938 | ||
939 | ------------ | |
940 | -- Insert -- | |
941 | ------------ | |
942 | ||
943 | procedure Insert | |
944 | (Container : in out List; | |
945 | Before : Cursor; | |
946 | New_Item : Element_Type; | |
947 | Position : out Cursor; | |
948 | Count : Count_Type := 1) | |
949 | is | |
950 | J : Count_Type; | |
951 | ||
952 | begin | |
953 | ||
954 | if Container.K /= Plain then | |
955 | raise Program_Error with "cannot modify part of container"; | |
956 | end if; | |
957 | ||
958 | if Before.Node /= 0 then | |
959 | null; | |
960 | pragma Assert (Vet (Container, Before), "bad cursor in Insert"); | |
961 | end if; | |
962 | ||
963 | if Count = 0 then | |
964 | Position := Before; | |
965 | return; | |
966 | end if; | |
967 | ||
968 | if Container.Length > Container.Capacity - Count then | |
969 | raise Constraint_Error with "new length exceeds capacity"; | |
970 | end if; | |
971 | ||
972 | if Container.Plain.Busy > 0 then | |
973 | raise Program_Error with | |
974 | "attempt to tamper with elements (list is busy)"; | |
975 | end if; | |
976 | ||
977 | Allocate (Container, New_Item, New_Node => J); | |
978 | Insert_Internal (Container, Before.Node, New_Node => J); | |
979 | Position := (Node => J); | |
980 | ||
981 | for Index in 2 .. Count loop | |
982 | Allocate (Container, New_Item, New_Node => J); | |
983 | Insert_Internal (Container, Before.Node, New_Node => J); | |
984 | end loop; | |
985 | end Insert; | |
986 | ||
987 | procedure Insert | |
988 | (Container : in out List; | |
989 | Before : Cursor; | |
990 | New_Item : Element_Type; | |
991 | Count : Count_Type := 1) | |
992 | is | |
993 | Position : Cursor; | |
994 | ||
995 | begin | |
996 | Insert (Container, Before, New_Item, Position, Count); | |
997 | end Insert; | |
998 | ||
999 | procedure Insert | |
1000 | (Container : in out List; | |
1001 | Before : Cursor; | |
1002 | Position : out Cursor; | |
1003 | Count : Count_Type := 1) | |
1004 | is | |
1005 | J : Count_Type; | |
1006 | ||
1007 | begin | |
1008 | ||
1009 | if Container.K /= Plain then | |
1010 | raise Program_Error with "cannot modify part of container"; | |
1011 | end if; | |
1012 | ||
1013 | if Before.Node /= 0 then | |
1014 | null; | |
1015 | pragma Assert (Vet (Container, Before), "bad cursor in Insert"); | |
1016 | end if; | |
1017 | ||
1018 | if Count = 0 then | |
1019 | Position := Before; | |
1020 | return; | |
1021 | end if; | |
1022 | ||
1023 | if Container.Length > Container.Capacity - Count then | |
1024 | raise Constraint_Error with "new length exceeds capacity"; | |
1025 | end if; | |
1026 | ||
1027 | if Container.Plain.Busy > 0 then | |
1028 | raise Program_Error with | |
1029 | "attempt to tamper with elements (list is busy)"; | |
1030 | end if; | |
1031 | ||
1032 | Allocate (Container, New_Node => J); | |
1033 | Insert_Internal (Container, Before.Node, New_Node => J); | |
1034 | Position := (Node => J); | |
1035 | ||
1036 | for Index in 2 .. Count loop | |
1037 | Allocate (Container, New_Node => J); | |
1038 | Insert_Internal (Container, Before.Node, New_Node => J); | |
1039 | end loop; | |
1040 | end Insert; | |
1041 | ||
1042 | --------------------- | |
1043 | -- Insert_Internal -- | |
1044 | --------------------- | |
1045 | ||
1046 | procedure Insert_Internal | |
1047 | (Container : in out List; | |
1048 | Before : Count_Type; | |
1049 | New_Node : Count_Type) | |
1050 | is | |
1051 | begin | |
1052 | if Container.K /= Plain then | |
1053 | raise Program_Error with "cannot modify part of container"; | |
1054 | end if; | |
1055 | ||
1056 | declare | |
1057 | N : Node_Array renames Container.Plain.Nodes; | |
1058 | ||
1059 | begin | |
1060 | if Container.Length = 0 then | |
1061 | pragma Assert (Before = 0); | |
1062 | pragma Assert (Container.First = 0); | |
1063 | pragma Assert (Container.Last = 0); | |
1064 | ||
1065 | Container.First := New_Node; | |
1066 | Container.Last := New_Node; | |
1067 | ||
1068 | N (Container.First).Prev := 0; | |
1069 | N (Container.Last).Next := 0; | |
1070 | ||
1071 | elsif Before = 0 then | |
1072 | pragma Assert (N (Container.Last).Next = 0); | |
1073 | ||
1074 | N (Container.Last).Next := New_Node; | |
1075 | N (New_Node).Prev := Container.Last; | |
1076 | ||
1077 | Container.Last := New_Node; | |
1078 | N (Container.Last).Next := 0; | |
1079 | ||
1080 | elsif Before = Container.First then | |
1081 | pragma Assert (N (Container.First).Prev = 0); | |
1082 | ||
1083 | N (Container.First).Prev := New_Node; | |
1084 | N (New_Node).Next := Container.First; | |
1085 | ||
1086 | Container.First := New_Node; | |
1087 | N (Container.First).Prev := 0; | |
1088 | ||
1089 | else | |
1090 | pragma Assert (N (Container.First).Prev = 0); | |
1091 | pragma Assert (N (Container.Last).Next = 0); | |
1092 | ||
1093 | N (New_Node).Next := Before; | |
1094 | N (New_Node).Prev := N (Before).Prev; | |
1095 | ||
1096 | N (N (Before).Prev).Next := New_Node; | |
1097 | N (Before).Prev := New_Node; | |
1098 | end if; | |
1099 | ||
1100 | Container.Length := Container.Length + 1; | |
1101 | end; | |
1102 | end Insert_Internal; | |
1103 | ||
1104 | -------------- | |
1105 | -- Is_Empty -- | |
1106 | -------------- | |
1107 | ||
1108 | function Is_Empty (Container : List) return Boolean is | |
1109 | begin | |
1110 | return Length (Container) = 0; | |
1111 | end Is_Empty; | |
1112 | ||
1113 | ------------- | |
1114 | -- Iterate -- | |
1115 | ------------- | |
1116 | ||
1117 | procedure Iterate_Between | |
1118 | (Container : List; | |
1119 | From : Count_Type; | |
1120 | To : Count_Type; | |
1121 | Process : | |
1122 | not null access procedure (Container : List; Position : Cursor)) | |
1123 | is | |
1124 | C : Plain_List renames Container.Plain.all; | |
1125 | N : Node_Array renames C.Nodes; | |
1126 | B : Natural renames C.Busy; | |
1127 | ||
1128 | Node : Count_Type := From; | |
1129 | ||
1130 | begin | |
1131 | B := B + 1; | |
1132 | ||
1133 | begin | |
1134 | while Node /= N (To).Next loop | |
1135 | pragma Assert (N (Node).Prev >= 0); | |
1136 | Process (Container, Position => (Node => Node)); | |
1137 | Node := N (Node).Next; | |
1138 | end loop; | |
1139 | exception | |
1140 | when others => | |
1141 | B := B - 1; | |
1142 | raise; | |
1143 | end; | |
1144 | ||
1145 | B := B - 1; | |
1146 | end Iterate_Between; | |
1147 | ||
1148 | procedure Iterate | |
1149 | (Container : List; | |
1150 | Process : | |
1151 | not null access procedure (Container : List; Position : Cursor)) | |
1152 | is | |
1153 | begin | |
1154 | if Container.Length = 0 then | |
1155 | return; | |
1156 | end if; | |
1157 | Iterate_Between (Container, Container.First, Container.Last, Process); | |
1158 | end Iterate; | |
1159 | ||
1160 | ---------- | |
1161 | -- Last -- | |
1162 | ---------- | |
1163 | ||
1164 | function Last (Container : List) return Cursor is | |
1165 | begin | |
1166 | if Container.Last = 0 then | |
1167 | return No_Element; | |
1168 | end if; | |
1169 | return (Node => Container.Last); | |
1170 | end Last; | |
1171 | ||
1172 | ------------------ | |
1173 | -- Last_Element -- | |
1174 | ------------------ | |
1175 | ||
1176 | function Last_Element (Container : List) return Element_Type is | |
1177 | L : constant Count_Type := Container.Last; | |
1178 | begin | |
1179 | if L = 0 then | |
1180 | raise Constraint_Error with "list is empty"; | |
1181 | else | |
1182 | return Element_Unchecked (Container, L); | |
1183 | end if; | |
1184 | end Last_Element; | |
1185 | ||
1186 | ---------- | |
1187 | -- Left -- | |
1188 | ---------- | |
1189 | ||
1190 | function Left (Container : List; Position : Cursor) return List is | |
1191 | L : Count_Type := 0; | |
1192 | C : Count_Type := Container.First; | |
1193 | LLe : Count_Type; | |
1194 | LF : Count_Type; | |
1195 | LLa : Count_Type; | |
1196 | begin | |
1197 | case Container.K is | |
1198 | when Plain => | |
1199 | LLe := Container.Length; | |
1200 | LF := Container.First; | |
1201 | LLa := Container.Last; | |
1202 | when Part => | |
1203 | LLe := Container.Part.LLength; | |
1204 | LF := Container.Part.LFirst; | |
1205 | LLa := Container.Part.LLast; | |
1206 | end case; | |
1207 | if Position.Node = 0 then | |
1208 | return (Capacity => Container.Capacity, | |
1209 | K => Part, | |
1210 | Length => Container.Length, | |
1211 | First => Container.First, | |
1212 | Last => Container.Last, | |
1213 | Plain => Container.Plain, | |
1214 | Part => (LLength => LLe, LFirst => LF, LLast => LLa)); | |
1215 | else | |
1216 | while C /= Position.Node loop | |
1217 | if C = Container.Last or C = 0 then | |
1218 | raise Constraint_Error with | |
1219 | "Position cursor has no element"; | |
1220 | end if; | |
1221 | C := Next_Unchecked (Container, C); | |
1222 | L := L + 1; | |
1223 | end loop; | |
1224 | if L = 0 then | |
1225 | return (Capacity => Container.Capacity, | |
1226 | K => Part, | |
1227 | Length => 0, | |
1228 | First => 0, | |
1229 | Last => 0, | |
1230 | Plain => Container.Plain, | |
1231 | Part => (LLength => LLe, LFirst => LF, LLast => LLa)); | |
1232 | else | |
1233 | return (Capacity => Container.Capacity, | |
1234 | K => Part, | |
1235 | Length => L, | |
1236 | First => Container.First, | |
1237 | Last => Container.Plain.Nodes (C).Prev, | |
1238 | Plain => Container.Plain, | |
1239 | Part => (LLength => LLe, LFirst => LF, LLast => LLa)); | |
1240 | end if; | |
1241 | end if; | |
1242 | end Left; | |
1243 | ||
1244 | ------------ | |
1245 | -- Length -- | |
1246 | ------------ | |
1247 | ||
1248 | function Length (Container : List) return Count_Type is | |
1249 | begin | |
1250 | return Container.Length; | |
1251 | end Length; | |
1252 | ||
1253 | ---------- | |
1254 | -- Move -- | |
1255 | ---------- | |
1256 | ||
1257 | procedure Move | |
1258 | (Target : in out List; | |
1259 | Source : in out List) | |
1260 | is | |
1261 | begin | |
1262 | if Target.K /= Plain or Source.K /= Plain then | |
1263 | raise Program_Error with "cannot modify part of container"; | |
1264 | end if; | |
1265 | ||
1266 | declare | |
1267 | ||
1268 | N : Node_Array renames Source.Plain.Nodes; | |
1269 | X : Count_Type; | |
1270 | ||
1271 | begin | |
1272 | if Target'Address = Source'Address then | |
1273 | return; | |
1274 | end if; | |
1275 | ||
1276 | if Target.Capacity < Source.Length then | |
1277 | raise Constraint_Error with -- ??? | |
1278 | "Source length exceeds Target capacity"; | |
1279 | end if; | |
1280 | ||
1281 | if Source.Plain.Busy > 0 then | |
1282 | raise Program_Error with | |
1283 | "attempt to tamper with cursors of Source (list is busy)"; | |
1284 | end if; | |
1285 | ||
1286 | Clear (Target); | |
1287 | ||
1288 | while Source.Length > 0 loop | |
1289 | X := Source.First; | |
1290 | Append (Target, N (X).Element); -- optimize away??? | |
1291 | ||
1292 | Source.First := N (X).Next; | |
1293 | N (Source.First).Prev := 0; | |
1294 | ||
1295 | Source.Length := Source.Length - 1; | |
1296 | Free (Source.Plain.all, X); | |
1297 | end loop; | |
1298 | end; | |
1299 | end Move; | |
1300 | ||
1301 | ---------- | |
1302 | -- Next -- | |
1303 | ---------- | |
1304 | ||
1305 | procedure Next (Container : List; Position : in out Cursor) is | |
1306 | begin | |
1307 | Position := Next (Container, Position); | |
1308 | end Next; | |
1309 | ||
1310 | function Next (Container : List; Position : Cursor) return Cursor is | |
1311 | begin | |
1312 | if Position.Node = 0 then | |
1313 | return No_Element; | |
1314 | end if; | |
1315 | if not Has_Element (Container, Position) then | |
1316 | raise Program_Error with "Position cursor has no element"; | |
1317 | end if; | |
1318 | return (Node => Next_Unchecked (Container, Position.Node)); | |
1319 | end Next; | |
1320 | ||
1321 | function Next_Unchecked (Container : List; Position : Count_Type) | |
1322 | return Count_Type | |
1323 | is | |
1324 | begin | |
1325 | case Container.K is | |
1326 | when Plain => | |
1327 | return Container.Plain.Nodes (Position).Next; | |
1328 | when Part => | |
1329 | if Position = Container.Last then | |
1330 | return 0; | |
1331 | else | |
1332 | return Container.Plain.Nodes (Position).Next; | |
1333 | end if; | |
1334 | end case; | |
1335 | end Next_Unchecked; | |
1336 | ||
1337 | ------------- | |
1338 | -- Prepend -- | |
1339 | ------------- | |
1340 | ||
1341 | procedure Prepend | |
1342 | (Container : in out List; | |
1343 | New_Item : Element_Type; | |
1344 | Count : Count_Type := 1) | |
1345 | is | |
1346 | begin | |
1347 | Insert (Container, First (Container), New_Item, Count); | |
1348 | end Prepend; | |
1349 | ||
1350 | -------------- | |
1351 | -- Previous -- | |
1352 | -------------- | |
1353 | ||
1354 | procedure Previous (Container : List; Position : in out Cursor) is | |
1355 | begin | |
1356 | Position := Previous (Container, Position); | |
1357 | end Previous; | |
1358 | ||
1359 | function Previous (Container : List; Position : Cursor) return Cursor is | |
1360 | begin | |
1361 | if Position.Node = 0 then | |
1362 | return No_Element; | |
1363 | end if; | |
1364 | ||
1365 | if not Has_Element (Container, Position) then | |
1366 | raise Program_Error with "Position cursor has no element"; | |
1367 | end if; | |
1368 | ||
1369 | case Container.K is | |
1370 | when Plain => | |
1371 | return (Node => Container.Plain.Nodes (Position.Node).Prev); | |
1372 | when Part => | |
1373 | if Container.First = Position.Node then | |
1374 | return No_Element; | |
1375 | else | |
1376 | return (Node => Container.Plain.Nodes (Position.Node).Prev); | |
1377 | end if; | |
1378 | end case; | |
1379 | end Previous; | |
1380 | ||
1381 | ------------------- | |
1382 | -- Query_Element -- | |
1383 | ------------------- | |
1384 | ||
1385 | procedure Query_Element_Plain | |
1386 | (Container : Plain_List; Position : Cursor; | |
1387 | Process : not null access procedure (Element : Element_Type)) | |
1388 | is | |
1389 | C : Plain_List renames Container'Unrestricted_Access.all; | |
1390 | B : Natural renames C.Busy; | |
1391 | L : Natural renames C.Lock; | |
1392 | ||
1393 | begin | |
1394 | B := B + 1; | |
1395 | L := L + 1; | |
1396 | ||
1397 | declare | |
1398 | N : Node_Type renames C.Nodes (Position.Node); | |
1399 | begin | |
1400 | Process (N.Element); | |
1401 | exception | |
1402 | when others => | |
1403 | L := L - 1; | |
1404 | B := B - 1; | |
1405 | raise; | |
1406 | end; | |
1407 | ||
1408 | L := L - 1; | |
1409 | B := B - 1; | |
1410 | end Query_Element_Plain; | |
1411 | ||
1412 | procedure Query_Element | |
1413 | (Container : List; Position : Cursor; | |
1414 | Process : not null access procedure (Element : Element_Type)) | |
1415 | is | |
1416 | begin | |
1417 | if not Has_Element (Container, Position) then | |
1418 | raise Constraint_Error with | |
1419 | "Position cursor has no element"; | |
1420 | end if; | |
1421 | Query_Element_Plain (Container.Plain.all, Position, Process); | |
1422 | end Query_Element; | |
1423 | ||
1424 | ---------- | |
1425 | -- Read -- | |
1426 | ---------- | |
1427 | ||
1428 | procedure Read | |
1429 | (Stream : not null access Root_Stream_Type'Class; | |
1430 | Item : out List) | |
1431 | is | |
1432 | N : Count_Type'Base; | |
1433 | ||
1434 | begin | |
1435 | Clear (Item); | |
1436 | ||
1437 | Count_Type'Base'Read (Stream, N); | |
1438 | ||
1439 | if N < 0 then | |
1440 | raise Program_Error with "bad list length"; | |
1441 | end if; | |
1442 | ||
1443 | if N = 0 then | |
1444 | return; | |
1445 | end if; | |
1446 | ||
1447 | if N > Item.Capacity then | |
1448 | raise Constraint_Error with "length exceeds capacity"; | |
1449 | end if; | |
1450 | ||
1451 | for J in 1 .. N loop | |
1452 | Item.Append (Element_Type'Input (Stream)); -- ??? | |
1453 | end loop; | |
1454 | end Read; | |
1455 | ||
1456 | procedure Read | |
1457 | (Stream : not null access Root_Stream_Type'Class; | |
1458 | Item : out Cursor) | |
1459 | is | |
1460 | begin | |
1461 | raise Program_Error with "attempt to stream list cursor"; | |
1462 | end Read; | |
1463 | ||
1464 | --------------------- | |
1465 | -- Replace_Element -- | |
1466 | --------------------- | |
1467 | ||
1468 | procedure Replace_Element | |
1469 | (Container : in out List; | |
1470 | Position : Cursor; | |
1471 | New_Item : Element_Type) | |
1472 | is | |
1473 | begin | |
1474 | if Container.K /= Plain then | |
1475 | raise Program_Error with "cannot modify part of container"; | |
1476 | end if; | |
1477 | ||
1478 | if not Has_Element (Container, Position) then | |
1479 | raise Constraint_Error with "Position cursor has no element"; | |
1480 | end if; | |
1481 | ||
1482 | if Container.Plain.Lock > 0 then | |
1483 | raise Program_Error with | |
1484 | "attempt to tamper with cursors (list is locked)"; | |
1485 | end if; | |
1486 | ||
1487 | pragma Assert (Vet (Container, Position), | |
1488 | "bad cursor in Replace_Element"); | |
1489 | ||
1490 | declare | |
1491 | N : Node_Array renames Container.Plain.Nodes; | |
1492 | begin | |
1493 | N (Position.Node).Element := New_Item; | |
1494 | end; | |
1495 | end Replace_Element; | |
1496 | ||
1497 | ---------------------- | |
1498 | -- Reverse_Elements -- | |
1499 | ---------------------- | |
1500 | ||
1501 | procedure Reverse_Elements (Container : in out List) is | |
1502 | begin | |
1503 | if Container.K /= Plain then | |
1504 | raise Program_Error with "cannot modify part of container"; | |
1505 | end if; | |
1506 | ||
1507 | declare | |
1508 | N : Node_Array renames Container.Plain.Nodes; | |
1509 | I : Count_Type := Container.First; | |
1510 | J : Count_Type := Container.Last; | |
1511 | ||
1512 | procedure Swap (L, R : Count_Type); | |
1513 | ||
1514 | ---------- | |
1515 | -- Swap -- | |
1516 | ---------- | |
1517 | ||
1518 | procedure Swap (L, R : Count_Type) is | |
1519 | LN : constant Count_Type := N (L).Next; | |
1520 | LP : constant Count_Type := N (L).Prev; | |
1521 | ||
1522 | RN : constant Count_Type := N (R).Next; | |
1523 | RP : constant Count_Type := N (R).Prev; | |
1524 | ||
1525 | begin | |
1526 | if LP /= 0 then | |
1527 | N (LP).Next := R; | |
1528 | end if; | |
1529 | ||
1530 | if RN /= 0 then | |
1531 | N (RN).Prev := L; | |
1532 | end if; | |
1533 | ||
1534 | N (L).Next := RN; | |
1535 | N (R).Prev := LP; | |
1536 | ||
1537 | if LN = R then | |
1538 | pragma Assert (RP = L); | |
1539 | ||
1540 | N (L).Prev := R; | |
1541 | N (R).Next := L; | |
1542 | ||
1543 | else | |
1544 | N (L).Prev := RP; | |
1545 | N (RP).Next := L; | |
1546 | ||
1547 | N (R).Next := LN; | |
1548 | N (LN).Prev := R; | |
1549 | end if; | |
1550 | end Swap; | |
1551 | ||
1552 | -- Start of processing for Reverse_Elements | |
1553 | ||
1554 | begin | |
1555 | if Container.Length <= 1 then | |
1556 | return; | |
1557 | end if; | |
1558 | ||
1559 | pragma Assert (N (Container.First).Prev = 0); | |
1560 | pragma Assert (N (Container.Last).Next = 0); | |
1561 | ||
1562 | if Container.Plain.Busy > 0 then | |
1563 | raise Program_Error with | |
1564 | "attempt to tamper with elements (list is busy)"; | |
1565 | end if; | |
1566 | ||
1567 | Container.First := J; | |
1568 | Container.Last := I; | |
1569 | loop | |
1570 | Swap (L => I, R => J); | |
1571 | ||
1572 | J := N (J).Next; | |
1573 | exit when I = J; | |
1574 | ||
1575 | I := N (I).Prev; | |
1576 | exit when I = J; | |
1577 | ||
1578 | Swap (L => J, R => I); | |
1579 | ||
1580 | I := N (I).Next; | |
1581 | exit when I = J; | |
1582 | ||
1583 | J := N (J).Prev; | |
1584 | exit when I = J; | |
1585 | end loop; | |
1586 | ||
1587 | pragma Assert (N (Container.First).Prev = 0); | |
1588 | pragma Assert (N (Container.Last).Next = 0); | |
1589 | end; | |
1590 | end Reverse_Elements; | |
1591 | ||
1592 | ------------------ | |
1593 | -- Reverse_Find -- | |
1594 | ------------------ | |
1595 | ||
1596 | function Reverse_Find_Between | |
1597 | (Container : Plain_List; | |
1598 | Item : Element_Type; | |
1599 | From : Count_Type; | |
1600 | To : Count_Type) return Cursor | |
1601 | is | |
1602 | Nodes : Node_Array renames Container.Nodes; | |
1603 | Node : Count_Type := To; | |
1604 | begin | |
1605 | while Node /= Nodes (From).Prev loop | |
1606 | if Nodes (Node).Element = Item then | |
1607 | return (Node => Node); | |
1608 | end if; | |
1609 | Node := Nodes (Node).Prev; | |
1610 | end loop; | |
1611 | ||
1612 | return No_Element; | |
1613 | end Reverse_Find_Between; | |
1614 | ||
1615 | function Reverse_Find | |
1616 | (Container : List; | |
1617 | Item : Element_Type; | |
1618 | Position : Cursor := No_Element) return Cursor | |
1619 | is | |
1620 | CFirst : Count_Type := Position.Node; | |
1621 | begin | |
1622 | if CFirst = 0 then | |
1623 | CFirst := Container.First; | |
1624 | end if; | |
1625 | ||
1626 | if Container.Length = 0 then | |
1627 | return No_Element; | |
1628 | end if; | |
1629 | return Reverse_Find_Between (Container => Container.Plain.all, | |
1630 | Item => Item, | |
1631 | From => CFirst, | |
1632 | To => Container.Last); | |
1633 | end Reverse_Find; | |
1634 | ||
1635 | --------------------- | |
1636 | -- Reverse_Iterate -- | |
1637 | --------------------- | |
1638 | ||
1639 | procedure Reverse_Iterate_Between | |
1640 | (Container : List; | |
1641 | From : Count_Type; | |
1642 | To : Count_Type; | |
1643 | Process : | |
1644 | not null access procedure (Container : List; Position : Cursor)) | |
1645 | is | |
1646 | C : Plain_List renames Container.Plain.all; | |
1647 | N : Node_Array renames C.Nodes; | |
1648 | B : Natural renames C.Busy; | |
1649 | ||
1650 | Node : Count_Type := To; | |
1651 | ||
1652 | begin | |
1653 | B := B + 1; | |
1654 | ||
1655 | begin | |
1656 | while Node /= N (From).Prev loop | |
1657 | pragma Assert (N (Node).Prev >= 0); | |
1658 | Process (Container, Position => (Node => Node)); | |
1659 | Node := N (Node).Prev; | |
1660 | end loop; | |
1661 | ||
1662 | exception | |
1663 | when others => | |
1664 | B := B - 1; | |
1665 | raise; | |
1666 | end; | |
1667 | ||
1668 | B := B - 1; | |
1669 | end Reverse_Iterate_Between; | |
1670 | ||
1671 | procedure Reverse_Iterate | |
1672 | (Container : List; | |
1673 | Process : | |
1674 | not null access procedure (Container : List; Position : Cursor)) | |
1675 | is | |
1676 | begin | |
1677 | if Container.Length = 0 then | |
1678 | return; | |
1679 | end if; | |
1680 | Reverse_Iterate_Between | |
1681 | (Container, Container.First, Container.Last, Process); | |
1682 | end Reverse_Iterate; | |
1683 | ||
1684 | ----------- | |
1685 | -- Right -- | |
1686 | ----------- | |
1687 | ||
1688 | function Right (Container : List; Position : Cursor) return List is | |
1689 | L : Count_Type := 0; | |
1690 | C : Count_Type := Container.First; | |
1691 | LLe : Count_Type; | |
1692 | LF : Count_Type; | |
1693 | LLa : Count_Type; | |
1694 | begin | |
1695 | case Container.K is | |
1696 | when Plain => | |
1697 | LLe := Container.Length; | |
1698 | LF := Container.First; | |
1699 | LLa := Container.Last; | |
1700 | when Part => | |
1701 | LLe := Container.Part.LLength; | |
1702 | LF := Container.Part.LFirst; | |
1703 | LLa := Container.Part.LLast; | |
1704 | end case; | |
1705 | if Position.Node = 0 then | |
1706 | return (Capacity => Container.Capacity, | |
1707 | K => Part, | |
1708 | Length => 0, | |
1709 | First => 0, | |
1710 | Last => 0, | |
1711 | Plain => Container.Plain, | |
1712 | Part => (LLength => LLe, LFirst => LF, LLast => LLa)); | |
1713 | else | |
1714 | while C /= Position.Node loop | |
1715 | if C = Container.Last or C = 0 then | |
1716 | raise Constraint_Error with | |
1717 | "Position cursor has no element"; | |
1718 | end if; | |
1719 | C := Next_Unchecked (Container, C); | |
1720 | L := L + 1; | |
1721 | end loop; | |
1722 | return (Capacity => Container.Capacity, | |
1723 | K => Part, | |
1724 | Length => Container.Length - L, | |
1725 | First => Position.Node, | |
1726 | Last => Container.Last, | |
1727 | Plain => Container.Plain, | |
1728 | Part => (LLength => LLe, LFirst => LF, LLast => LLa)); | |
1729 | end if; | |
1730 | end Right; | |
1731 | ||
1732 | ------------ | |
1733 | -- Splice -- | |
1734 | ------------ | |
1735 | ||
1736 | procedure Splice | |
1737 | (Target : in out List; | |
1738 | Before : Cursor; | |
1739 | Source : in out List) | |
1740 | is | |
1741 | begin | |
1742 | if Target.K /= Plain or Source.K /= Plain then | |
1743 | raise Program_Error with "cannot modify part of container"; | |
1744 | end if; | |
1745 | ||
1746 | declare | |
1747 | SN : Node_Array renames Source.Plain.Nodes; | |
1748 | ||
1749 | begin | |
1750 | if Before.Node /= 0 then | |
1751 | null; | |
1752 | pragma Assert (Vet (Target, Before), "bad cursor in Splice"); | |
1753 | end if; | |
1754 | ||
1755 | if Target'Address = Source'Address | |
1756 | or else Source.Length = 0 | |
1757 | then | |
1758 | return; | |
1759 | end if; | |
1760 | ||
1761 | pragma Assert (SN (Source.First).Prev = 0); | |
1762 | pragma Assert (SN (Source.Last).Next = 0); | |
1763 | ||
1764 | if Target.Length > Count_Type'Base'Last - Source.Length then | |
1765 | raise Constraint_Error with "new length exceeds maximum"; | |
1766 | end if; | |
1767 | ||
1768 | if Target.Length + Source.Length > Target.Capacity then | |
1769 | raise Constraint_Error; | |
1770 | end if; | |
1771 | ||
1772 | if Target.Plain.Busy > 0 then | |
1773 | raise Program_Error with | |
1774 | "attempt to tamper with cursors of Target (list is busy)"; | |
1775 | end if; | |
1776 | ||
1777 | if Source.Plain.Busy > 0 then | |
1778 | raise Program_Error with | |
1779 | "attempt to tamper with cursors of Source (list is busy)"; | |
1780 | end if; | |
1781 | ||
1782 | loop | |
1783 | Insert (Target, Before, SN (Source.Last).Element); | |
1784 | Delete_Last (Source); | |
1785 | exit when Is_Empty (Source); | |
1786 | end loop; | |
1787 | end; | |
1788 | end Splice; | |
1789 | ||
1790 | procedure Splice | |
1791 | (Target : in out List; | |
1792 | Before : Cursor; | |
1793 | Source : in out List; | |
1794 | Position : in out Cursor) | |
1795 | is | |
1796 | Target_Position : Cursor; | |
1797 | ||
1798 | begin | |
1799 | if Target.K /= Plain or Source.K /= Plain then | |
1800 | raise Program_Error with "cannot modify part of container"; | |
1801 | end if; | |
1802 | ||
1803 | if Target'Address = Source'Address then | |
1804 | Splice (Target, Before, Position); | |
1805 | return; | |
1806 | end if; | |
1807 | ||
1808 | if Position.Node = 0 then | |
1809 | raise Constraint_Error with "Position cursor has no element"; | |
1810 | end if; | |
1811 | ||
1812 | pragma Assert (Vet (Source, Position), "bad Position cursor in Splice"); | |
1813 | ||
1814 | if Target.Length >= Target.Capacity then | |
1815 | raise Constraint_Error; | |
1816 | end if; | |
1817 | ||
1818 | if Target.Plain.Busy > 0 then | |
1819 | raise Program_Error with | |
1820 | "attempt to tamper with cursors of Target (list is busy)"; | |
1821 | end if; | |
1822 | ||
1823 | if Source.Plain.Busy > 0 then | |
1824 | raise Program_Error with | |
1825 | "attempt to tamper with cursors of Source (list is busy)"; | |
1826 | end if; | |
1827 | ||
1828 | Insert | |
1829 | (Container => Target, | |
1830 | Before => Before, | |
1831 | New_Item => Source.Plain.Nodes (Position.Node).Element, | |
1832 | Position => Target_Position); | |
1833 | ||
1834 | Delete (Source, Position); | |
1835 | Position := Target_Position; | |
1836 | end Splice; | |
1837 | ||
1838 | procedure Splice | |
1839 | (Container : in out List; | |
1840 | Before : Cursor; | |
1841 | Position : Cursor) | |
1842 | is | |
1843 | begin | |
1844 | if Container.K /= Plain then | |
1845 | raise Program_Error with "cannot modify part of container"; | |
1846 | end if; | |
1847 | ||
1848 | declare | |
1849 | N : Node_Array renames Container.Plain.Nodes; | |
1850 | ||
1851 | begin | |
1852 | if Before.Node /= 0 then | |
1853 | null; | |
1854 | pragma Assert (Vet (Container, Before), | |
1855 | "bad Before cursor in Splice"); | |
1856 | end if; | |
1857 | ||
1858 | if Position.Node = 0 then | |
1859 | raise Constraint_Error with "Position cursor has no element"; | |
1860 | end if; | |
1861 | ||
1862 | pragma Assert (Vet (Container, Position), | |
1863 | "bad Position cursor in Splice"); | |
1864 | ||
1865 | if Position.Node = Before.Node | |
1866 | or else N (Position.Node).Next = Before.Node | |
1867 | then | |
1868 | return; | |
1869 | end if; | |
1870 | ||
1871 | pragma Assert (Container.Length >= 2); | |
1872 | ||
1873 | if Container.Plain.Busy > 0 then | |
1874 | raise Program_Error with | |
1875 | "attempt to tamper with elements (list is busy)"; | |
1876 | end if; | |
1877 | ||
1878 | if Before.Node = 0 then | |
1879 | pragma Assert (Position.Node /= Container.Last); | |
1880 | ||
1881 | if Position.Node = Container.First then | |
1882 | Container.First := N (Position.Node).Next; | |
1883 | N (Container.First).Prev := 0; | |
1884 | ||
1885 | else | |
1886 | N (N (Position.Node).Prev).Next := N (Position.Node).Next; | |
1887 | N (N (Position.Node).Next).Prev := N (Position.Node).Prev; | |
1888 | end if; | |
1889 | ||
1890 | N (Container.Last).Next := Position.Node; | |
1891 | N (Position.Node).Prev := Container.Last; | |
1892 | ||
1893 | Container.Last := Position.Node; | |
1894 | N (Container.Last).Next := 0; | |
1895 | ||
1896 | return; | |
1897 | end if; | |
1898 | ||
1899 | if Before.Node = Container.First then | |
1900 | pragma Assert (Position.Node /= Container.First); | |
1901 | ||
1902 | if Position.Node = Container.Last then | |
1903 | Container.Last := N (Position.Node).Prev; | |
1904 | N (Container.Last).Next := 0; | |
1905 | ||
1906 | else | |
1907 | N (N (Position.Node).Prev).Next := N (Position.Node).Next; | |
1908 | N (N (Position.Node).Next).Prev := N (Position.Node).Prev; | |
1909 | end if; | |
1910 | ||
1911 | N (Container.First).Prev := Position.Node; | |
1912 | N (Position.Node).Next := Container.First; | |
1913 | ||
1914 | Container.First := Position.Node; | |
1915 | N (Container.First).Prev := 0; | |
1916 | ||
1917 | return; | |
1918 | end if; | |
1919 | ||
1920 | if Position.Node = Container.First then | |
1921 | Container.First := N (Position.Node).Next; | |
1922 | N (Container.First).Prev := 0; | |
1923 | ||
1924 | elsif Position.Node = Container.Last then | |
1925 | Container.Last := N (Position.Node).Prev; | |
1926 | N (Container.Last).Next := 0; | |
1927 | ||
1928 | else | |
1929 | N (N (Position.Node).Prev).Next := N (Position.Node).Next; | |
1930 | N (N (Position.Node).Next).Prev := N (Position.Node).Prev; | |
1931 | end if; | |
1932 | ||
1933 | N (N (Before.Node).Prev).Next := Position.Node; | |
1934 | N (Position.Node).Prev := N (Before.Node).Prev; | |
1935 | ||
1936 | N (Before.Node).Prev := Position.Node; | |
1937 | N (Position.Node).Next := Before.Node; | |
1938 | ||
1939 | pragma Assert (N (Container.First).Prev = 0); | |
1940 | pragma Assert (N (Container.Last).Next = 0); | |
1941 | end; | |
1942 | end Splice; | |
1943 | ||
1944 | ------------------ | |
1945 | -- Strict_Equal -- | |
1946 | ------------------ | |
1947 | ||
1948 | function Strict_Equal (Left, Right : List) return Boolean is | |
1949 | CL : Count_Type := Left.First; | |
1950 | CR : Count_Type := Right.First; | |
1951 | begin | |
1952 | while CL /= 0 or CR /= 0 loop | |
1953 | if CL /= CR or else | |
1954 | Element_Unchecked (Left, CL) /= Element_Unchecked (Right, CL) then | |
1955 | return False; | |
1956 | end if; | |
1957 | CL := Next_Unchecked (Left, CL); | |
1958 | CR := Next_Unchecked (Right, CR); | |
1959 | end loop; | |
1960 | return True; | |
1961 | end Strict_Equal; | |
1962 | ||
1963 | ---------- | |
1964 | -- Swap -- | |
1965 | ---------- | |
1966 | ||
1967 | procedure Swap | |
1968 | (Container : in out List; | |
1969 | I, J : Cursor) | |
1970 | is | |
1971 | begin | |
1972 | if Container.K /= Plain then | |
1973 | raise Program_Error with "cannot modify part of container"; | |
1974 | end if; | |
1975 | ||
1976 | if I.Node = 0 then | |
1977 | raise Constraint_Error with "I cursor has no element"; | |
1978 | end if; | |
1979 | ||
1980 | if J.Node = 0 then | |
1981 | raise Constraint_Error with "J cursor has no element"; | |
1982 | end if; | |
1983 | ||
1984 | if I.Node = J.Node then | |
1985 | return; | |
1986 | end if; | |
1987 | ||
1988 | if Container.Plain.Lock > 0 then | |
1989 | raise Program_Error with | |
1990 | "attempt to tamper with cursors (list is locked)"; | |
1991 | end if; | |
1992 | ||
1993 | pragma Assert (Vet (Container, I), "bad I cursor in Swap"); | |
1994 | pragma Assert (Vet (Container, J), "bad J cursor in Swap"); | |
1995 | ||
1996 | declare | |
1997 | NN : Node_Array renames Container.Plain.Nodes; | |
1998 | NI : Node_Type renames NN (I.Node); | |
1999 | NJ : Node_Type renames NN (J.Node); | |
2000 | ||
2001 | EI_Copy : constant Element_Type := NI.Element; | |
2002 | ||
2003 | begin | |
2004 | NI.Element := NJ.Element; | |
2005 | NJ.Element := EI_Copy; | |
2006 | end; | |
2007 | end Swap; | |
2008 | ||
2009 | ---------------- | |
2010 | -- Swap_Links -- | |
2011 | ---------------- | |
2012 | ||
2013 | procedure Swap_Links | |
2014 | (Container : in out List; | |
2015 | I, J : Cursor) | |
2016 | is | |
2017 | I_Next, J_Next : Cursor; | |
2018 | ||
2019 | begin | |
2020 | if Container.K /= Plain then | |
2021 | raise Program_Error with "cannot modify part of container"; | |
2022 | end if; | |
2023 | ||
2024 | if I.Node = 0 then | |
2025 | raise Constraint_Error with "I cursor has no element"; | |
2026 | end if; | |
2027 | ||
2028 | if J.Node = 0 then | |
2029 | raise Constraint_Error with "J cursor has no element"; | |
2030 | end if; | |
2031 | ||
2032 | if I.Node = J.Node then | |
2033 | return; | |
2034 | end if; | |
2035 | ||
2036 | if Container.Plain.Busy > 0 then | |
2037 | raise Program_Error with | |
2038 | "attempt to tamper with elements (list is busy)"; | |
2039 | end if; | |
2040 | ||
2041 | pragma Assert (Vet (Container, I), "bad I cursor in Swap_Links"); | |
2042 | pragma Assert (Vet (Container, J), "bad J cursor in Swap_Links"); | |
2043 | ||
2044 | I_Next := Next (Container, I); | |
2045 | ||
2046 | if I_Next = J then | |
2047 | Splice (Container, Before => I, Position => J); | |
2048 | ||
2049 | else | |
2050 | J_Next := Next (Container, J); | |
2051 | ||
2052 | if J_Next = I then | |
2053 | Splice (Container, Before => J, Position => I); | |
2054 | ||
2055 | else | |
2056 | pragma Assert (Container.Length >= 3); | |
2057 | Splice (Container, Before => I_Next, Position => J); | |
2058 | Splice (Container, Before => J_Next, Position => I); | |
2059 | end if; | |
2060 | end if; | |
2061 | end Swap_Links; | |
2062 | ||
2063 | -------------------- | |
2064 | -- Update_Element -- | |
2065 | -------------------- | |
2066 | ||
2067 | procedure Update_Element | |
2068 | (Container : in out List; | |
2069 | Position : Cursor; | |
2070 | Process : not null access procedure (Element : in out Element_Type)) | |
2071 | is | |
2072 | begin | |
2073 | if Container.K /= Plain then | |
2074 | raise Program_Error with "cannot modify part of container"; | |
2075 | end if; | |
2076 | ||
2077 | if Position.Node = 0 then | |
2078 | raise Constraint_Error with "Position cursor has no element"; | |
2079 | end if; | |
2080 | ||
2081 | pragma Assert (Vet (Container, Position), | |
2082 | "bad cursor in Update_Element"); | |
2083 | ||
2084 | declare | |
2085 | B : Natural renames Container.Plain.Busy; | |
2086 | L : Natural renames Container.Plain.Lock; | |
2087 | ||
2088 | begin | |
2089 | B := B + 1; | |
2090 | L := L + 1; | |
2091 | ||
2092 | declare | |
2093 | N : Node_Type renames Container.Plain.Nodes (Position.Node); | |
2094 | begin | |
2095 | Process (N.Element); | |
2096 | exception | |
2097 | when others => | |
2098 | L := L - 1; | |
2099 | B := B - 1; | |
2100 | raise; | |
2101 | end; | |
2102 | ||
2103 | L := L - 1; | |
2104 | B := B - 1; | |
2105 | end; | |
2106 | end Update_Element; | |
2107 | ||
2108 | --------- | |
2109 | -- Vet -- | |
2110 | --------- | |
2111 | ||
2112 | function Vet (L : List; Position : Cursor) return Boolean is | |
2113 | begin | |
2114 | if L.K /= Plain then | |
2115 | raise Program_Error with "cannot modify part of container"; | |
2116 | end if; | |
2117 | ||
2118 | declare | |
2119 | N : Node_Array renames L.Plain.Nodes; | |
2120 | ||
2121 | begin | |
2122 | if L.Length = 0 then | |
2123 | return False; | |
2124 | end if; | |
2125 | ||
2126 | if L.First = 0 then | |
2127 | return False; | |
2128 | end if; | |
2129 | ||
2130 | if L.Last = 0 then | |
2131 | return False; | |
2132 | end if; | |
2133 | ||
2134 | if Position.Node > L.Capacity then | |
2135 | return False; | |
2136 | end if; | |
2137 | ||
2138 | if N (Position.Node).Prev < 0 | |
2139 | or else N (Position.Node).Prev > L.Capacity | |
2140 | then | |
2141 | return False; | |
2142 | end if; | |
2143 | ||
2144 | if N (Position.Node).Next > L.Capacity then | |
2145 | return False; | |
2146 | end if; | |
2147 | ||
2148 | if N (L.First).Prev /= 0 then | |
2149 | return False; | |
2150 | end if; | |
2151 | ||
2152 | if N (L.Last).Next /= 0 then | |
2153 | return False; | |
2154 | end if; | |
2155 | ||
2156 | if N (Position.Node).Prev = 0 | |
2157 | and then Position.Node /= L.First | |
2158 | then | |
2159 | return False; | |
2160 | end if; | |
2161 | ||
2162 | if N (Position.Node).Next = 0 | |
2163 | and then Position.Node /= L.Last | |
2164 | then | |
2165 | return False; | |
2166 | end if; | |
2167 | ||
2168 | if L.Length = 1 then | |
2169 | return L.First = L.Last; | |
2170 | end if; | |
2171 | ||
2172 | if L.First = L.Last then | |
2173 | return False; | |
2174 | end if; | |
2175 | ||
2176 | if N (L.First).Next = 0 then | |
2177 | return False; | |
2178 | end if; | |
2179 | ||
2180 | if N (L.Last).Prev = 0 then | |
2181 | return False; | |
2182 | end if; | |
2183 | ||
2184 | if N (N (L.First).Next).Prev /= L.First then | |
2185 | return False; | |
2186 | end if; | |
2187 | ||
2188 | if N (N (L.Last).Prev).Next /= L.Last then | |
2189 | return False; | |
2190 | end if; | |
2191 | ||
2192 | if L.Length = 2 then | |
2193 | if N (L.First).Next /= L.Last then | |
2194 | return False; | |
2195 | end if; | |
2196 | ||
2197 | if N (L.Last).Prev /= L.First then | |
2198 | return False; | |
2199 | end if; | |
2200 | ||
2201 | return True; | |
2202 | end if; | |
2203 | ||
2204 | if N (L.First).Next = L.Last then | |
2205 | return False; | |
2206 | end if; | |
2207 | ||
2208 | if N (L.Last).Prev = L.First then | |
2209 | return False; | |
2210 | end if; | |
2211 | ||
2212 | if Position.Node = L.First then | |
2213 | return True; | |
2214 | end if; | |
2215 | ||
2216 | if Position.Node = L.Last then | |
2217 | return True; | |
2218 | end if; | |
2219 | ||
2220 | if N (Position.Node).Next = 0 then | |
2221 | return False; | |
2222 | end if; | |
2223 | ||
2224 | if N (Position.Node).Prev = 0 then | |
2225 | return False; | |
2226 | end if; | |
2227 | ||
2228 | if N (N (Position.Node).Next).Prev /= Position.Node then | |
2229 | return False; | |
2230 | end if; | |
2231 | ||
2232 | if N (N (Position.Node).Prev).Next /= Position.Node then | |
2233 | return False; | |
2234 | end if; | |
2235 | ||
2236 | if L.Length = 3 then | |
2237 | if N (L.First).Next /= Position.Node then | |
2238 | return False; | |
2239 | end if; | |
2240 | ||
2241 | if N (L.Last).Prev /= Position.Node then | |
2242 | return False; | |
2243 | end if; | |
2244 | end if; | |
2245 | ||
2246 | return True; | |
2247 | end; | |
2248 | end Vet; | |
2249 | ||
2250 | ----------- | |
2251 | -- Write -- | |
2252 | ----------- | |
2253 | ||
2254 | procedure Write_Between | |
2255 | (Stream : not null access Root_Stream_Type'Class; | |
2256 | Item : Plain_List; | |
2257 | Length : Count_Type; | |
2258 | From : Count_Type; | |
2259 | To : Count_Type) is | |
2260 | ||
2261 | N : Node_Array renames Item.Nodes; | |
2262 | Node : Count_Type; | |
2263 | ||
2264 | begin | |
2265 | Count_Type'Base'Write (Stream, Length); | |
2266 | ||
2267 | Node := From; | |
2268 | while Node /= N (To).Next loop | |
2269 | Element_Type'Write (Stream, N (Node).Element); | |
2270 | Node := N (Node).Next; | |
2271 | end loop; | |
2272 | end Write_Between; | |
2273 | ||
2274 | procedure Write | |
2275 | (Stream : not null access Root_Stream_Type'Class; | |
2276 | Item : List) | |
2277 | is | |
2278 | begin | |
2279 | Write_Between | |
2280 | (Stream, Item.Plain.all, Item.Length, Item.First, Item.Last); | |
2281 | end Write; | |
2282 | ||
2283 | procedure Write | |
2284 | (Stream : not null access Root_Stream_Type'Class; | |
2285 | Item : Cursor) | |
2286 | is | |
2287 | begin | |
2288 | raise Program_Error with "attempt to stream list cursor"; | |
2289 | end Write; | |
2290 | ||
2291 | end Ada.Containers.Formal_Doubly_Linked_Lists; |