gcc/ada/a-cfdlli.adb

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