gcc/ada/a-cidlli.adb

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