gcc/ada/a-cborma.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --   A D A . C O N T A I N E R S . B O U N D E D _ O R D E R E D _ M A P S  --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2004-2014, 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 -- This unit was originally developed by Matthew J Heaney.                  --
  28 ------------------------------------------------------------------------------
  29
  30 with Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations;
  31 pragma Elaborate_All
  32   (Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations);
  33
  34 with Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys;
  35 pragma Elaborate_All
  36   (Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys);
  37
  38 with System; use type System.Address;
  39
  40 package body Ada.Containers.Bounded_Ordered_Maps is
  41
  42    pragma Annotate (CodePeer, Skip_Analysis);
  43
  44    -----------------------------
  45    -- Node Access Subprograms --
  46    -----------------------------
  47
  48    --  These subprograms provide a functional interface to access fields
  49    --  of a node, and a procedural interface for modifying these values.
  50
  51    function Color (Node : Node_Type) return Color_Type;
  52    pragma Inline (Color);
  53
  54    function Left (Node : Node_Type) return Count_Type;
  55    pragma Inline (Left);
  56
  57    function Parent (Node : Node_Type) return Count_Type;
  58    pragma Inline (Parent);
  59
  60    function Right (Node : Node_Type) return Count_Type;
  61    pragma Inline (Right);
  62
  63    procedure Set_Parent (Node : in out Node_Type; Parent : Count_Type);
  64    pragma Inline (Set_Parent);
  65
  66    procedure Set_Left (Node : in out Node_Type; Left : Count_Type);
  67    pragma Inline (Set_Left);
  68
  69    procedure Set_Right (Node : in out Node_Type; Right : Count_Type);
  70    pragma Inline (Set_Right);
  71
  72    procedure Set_Color (Node : in out Node_Type; Color : Color_Type);
  73    pragma Inline (Set_Color);
  74
  75    -----------------------
  76    -- Local Subprograms --
  77    -----------------------
  78
  79    function Is_Greater_Key_Node
  80      (Left  : Key_Type;
  81       Right : Node_Type) return Boolean;
  82    pragma Inline (Is_Greater_Key_Node);
  83
  84    function Is_Less_Key_Node
  85      (Left  : Key_Type;
  86       Right : Node_Type) return Boolean;
  87    pragma Inline (Is_Less_Key_Node);
  88
  89    --------------------------
  90    -- Local Instantiations --
  91    --------------------------
  92
  93    package Tree_Operations is
  94       new Red_Black_Trees.Generic_Bounded_Operations (Tree_Types);
  95
  96    use Tree_Operations;
  97
  98    package Key_Ops is
  99      new Red_Black_Trees.Generic_Bounded_Keys
 100        (Tree_Operations     => Tree_Operations,
 101         Key_Type            => Key_Type,
 102         Is_Less_Key_Node    => Is_Less_Key_Node,
 103         Is_Greater_Key_Node => Is_Greater_Key_Node);
 104
 105    ---------
 106    -- "<" --
 107    ---------
 108
 109    function "<" (Left, Right : Cursor) return Boolean is
 110    begin
 111       if Left.Node = 0 then
 112          raise Constraint_Error with "Left cursor of ""<"" equals No_Element";
 113       end if;
 114
 115       if Right.Node = 0 then
 116          raise Constraint_Error with "Right cursor of ""<"" equals No_Element";
 117       end if;
 118
 119       pragma Assert (Vet (Left.Container.all, Left.Node),
 120                      "Left cursor of ""<"" is bad");
 121
 122       pragma Assert (Vet (Right.Container.all, Right.Node),
 123                      "Right cursor of ""<"" is bad");
 124
 125       declare
 126          LN : Node_Type renames Left.Container.Nodes (Left.Node);
 127          RN : Node_Type renames Right.Container.Nodes (Right.Node);
 128
 129       begin
 130          return LN.Key < RN.Key;
 131       end;
 132    end "<";
 133
 134    function "<" (Left : Cursor; Right : Key_Type) return Boolean is
 135    begin
 136       if Left.Node = 0 then
 137          raise Constraint_Error with "Left cursor of ""<"" equals No_Element";
 138       end if;
 139
 140       pragma Assert (Vet (Left.Container.all, Left.Node),
 141                      "Left cursor of ""<"" is bad");
 142
 143       declare
 144          LN : Node_Type renames Left.Container.Nodes (Left.Node);
 145
 146       begin
 147          return LN.Key < Right;
 148       end;
 149    end "<";
 150
 151    function "<" (Left : Key_Type; Right : Cursor) return Boolean is
 152    begin
 153       if Right.Node = 0 then
 154          raise Constraint_Error with "Right cursor of ""<"" equals No_Element";
 155       end if;
 156
 157       pragma Assert (Vet (Right.Container.all, Right.Node),
 158                      "Right cursor of ""<"" is bad");
 159
 160       declare
 161          RN : Node_Type renames Right.Container.Nodes (Right.Node);
 162
 163       begin
 164          return Left < RN.Key;
 165       end;
 166    end "<";
 167
 168    ---------
 169    -- "=" --
 170    ---------
 171
 172    function "=" (Left, Right : Map) return Boolean is
 173       function Is_Equal_Node_Node (L, R : Node_Type) return Boolean;
 174       pragma Inline (Is_Equal_Node_Node);
 175
 176       function Is_Equal is
 177         new Tree_Operations.Generic_Equal (Is_Equal_Node_Node);
 178
 179       ------------------------
 180       -- Is_Equal_Node_Node --
 181       ------------------------
 182
 183       function Is_Equal_Node_Node
 184         (L, R : Node_Type) return Boolean is
 185       begin
 186          if L.Key < R.Key then
 187             return False;
 188
 189          elsif R.Key < L.Key then
 190             return False;
 191
 192          else
 193             return L.Element = R.Element;
 194          end if;
 195       end Is_Equal_Node_Node;
 196
 197    --  Start of processing for "="
 198
 199    begin
 200       return Is_Equal (Left, Right);
 201    end "=";
 202
 203    ---------
 204    -- ">" --
 205    ---------
 206
 207    function ">" (Left, Right : Cursor) return Boolean is
 208    begin
 209       if Left.Node = 0 then
 210          raise Constraint_Error with "Left cursor of "">"" equals No_Element";
 211       end if;
 212
 213       if Right.Node = 0 then
 214          raise Constraint_Error with "Right cursor of "">"" equals No_Element";
 215       end if;
 216
 217       pragma Assert (Vet (Left.Container.all, Left.Node),
 218                      "Left cursor of "">"" is bad");
 219
 220       pragma Assert (Vet (Right.Container.all, Right.Node),
 221                      "Right cursor of "">"" is bad");
 222
 223       declare
 224          LN : Node_Type renames Left.Container.Nodes (Left.Node);
 225          RN : Node_Type renames Right.Container.Nodes (Right.Node);
 226
 227       begin
 228          return RN.Key < LN.Key;
 229       end;
 230    end ">";
 231
 232    function ">" (Left : Cursor; Right : Key_Type) return Boolean is
 233    begin
 234       if Left.Node = 0 then
 235          raise Constraint_Error with "Left cursor of "">"" equals No_Element";
 236       end if;
 237
 238       pragma Assert (Vet (Left.Container.all, Left.Node),
 239                      "Left cursor of "">"" is bad");
 240
 241       declare
 242          LN : Node_Type renames Left.Container.Nodes (Left.Node);
 243       begin
 244          return Right < LN.Key;
 245       end;
 246    end ">";
 247
 248    function ">" (Left : Key_Type; Right : Cursor) return Boolean is
 249    begin
 250       if Right.Node = 0 then
 251          raise Constraint_Error with "Right cursor of "">"" equals No_Element";
 252       end if;
 253
 254       pragma Assert (Vet (Right.Container.all, Right.Node),
 255                      "Right cursor of "">"" is bad");
 256
 257       declare
 258          RN : Node_Type renames Right.Container.Nodes (Right.Node);
 259
 260       begin
 261          return RN.Key < Left;
 262       end;
 263    end ">";
 264
 265    ------------
 266    -- Adjust --
 267    ------------
 268
 269    procedure Adjust (Control : in out Reference_Control_Type) is
 270    begin
 271       if Control.Container /= null then
 272          declare
 273             C : Map renames Control.Container.all;
 274             B : Natural renames C.Busy;
 275             L : Natural renames C.Lock;
 276          begin
 277             B := B + 1;
 278             L := L + 1;
 279          end;
 280       end if;
 281    end Adjust;
 282
 283    ------------
 284    -- Assign --
 285    ------------
 286
 287    procedure Assign (Target : in out Map; Source : Map) is
 288       procedure Append_Element (Source_Node : Count_Type);
 289
 290       procedure Append_Elements is
 291          new Tree_Operations.Generic_Iteration (Append_Element);
 292
 293       --------------------
 294       -- Append_Element --
 295       --------------------
 296
 297       procedure Append_Element (Source_Node : Count_Type) is
 298          SN : Node_Type renames Source.Nodes (Source_Node);
 299
 300          procedure Set_Element (Node : in out Node_Type);
 301          pragma Inline (Set_Element);
 302
 303          function New_Node return Count_Type;
 304          pragma Inline (New_Node);
 305
 306          procedure Insert_Post is
 307             new Key_Ops.Generic_Insert_Post (New_Node);
 308
 309          procedure Unconditional_Insert_Sans_Hint is
 310             new Key_Ops.Generic_Unconditional_Insert (Insert_Post);
 311
 312          procedure Unconditional_Insert_Avec_Hint is
 313             new Key_Ops.Generic_Unconditional_Insert_With_Hint
 314               (Insert_Post,
 315                Unconditional_Insert_Sans_Hint);
 316
 317          procedure Allocate is
 318             new Tree_Operations.Generic_Allocate (Set_Element);
 319
 320          --------------
 321          -- New_Node --
 322          --------------
 323
 324          function New_Node return Count_Type is
 325             Result : Count_Type;
 326
 327          begin
 328             Allocate (Target, Result);
 329             return Result;
 330          end New_Node;
 331
 332          -----------------
 333          -- Set_Element --
 334          -----------------
 335
 336          procedure Set_Element (Node : in out Node_Type) is
 337          begin
 338             Node.Key := SN.Key;
 339             Node.Element := SN.Element;
 340          end Set_Element;
 341
 342          Target_Node : Count_Type;
 343
 344       --  Start of processing for Append_Element
 345
 346       begin
 347          Unconditional_Insert_Avec_Hint
 348            (Tree  => Target,
 349             Hint  => 0,
 350             Key   => SN.Key,
 351             Node  => Target_Node);
 352       end Append_Element;
 353
 354    --  Start of processing for Assign
 355
 356    begin
 357       if Target'Address = Source'Address then
 358          return;
 359       end if;
 360
 361       if Target.Capacity < Source.Length then
 362          raise Capacity_Error
 363            with "Target capacity is less than Source length";
 364       end if;
 365
 366       Tree_Operations.Clear_Tree (Target);
 367       Append_Elements (Source);
 368    end Assign;
 369
 370    -------------
 371    -- Ceiling --
 372    -------------
 373
 374    function Ceiling (Container : Map; Key : Key_Type) return Cursor is
 375       Node : constant Count_Type := Key_Ops.Ceiling (Container, Key);
 376
 377    begin
 378       if Node = 0 then
 379          return No_Element;
 380       end if;
 381
 382       return Cursor'(Container'Unrestricted_Access, Node);
 383    end Ceiling;
 384
 385    -----------
 386    -- Clear --
 387    -----------
 388
 389    procedure Clear (Container : in out Map) is
 390    begin
 391       Tree_Operations.Clear_Tree (Container);
 392    end Clear;
 393
 394    -----------
 395    -- Color --
 396    -----------
 397
 398    function Color (Node : Node_Type) return Color_Type is
 399    begin
 400       return Node.Color;
 401    end Color;
 402
 403    ------------------------
 404    -- Constant_Reference --
 405    ------------------------
 406
 407    function Constant_Reference
 408      (Container : aliased Map;
 409       Position  : Cursor) return Constant_Reference_Type
 410    is
 411    begin
 412       if Position.Container = null then
 413          raise Constraint_Error with
 414            "Position cursor has no element";
 415       end if;
 416
 417       if Position.Container /= Container'Unrestricted_Access then
 418          raise Program_Error with
 419            "Position cursor designates wrong map";
 420       end if;
 421
 422       pragma Assert (Vet (Container, Position.Node),
 423                      "Position cursor in Constant_Reference is bad");
 424
 425       declare
 426          N : Node_Type renames Container.Nodes (Position.Node);
 427          B : Natural renames Position.Container.Busy;
 428          L : Natural renames Position.Container.Lock;
 429
 430       begin
 431          return R : constant Constant_Reference_Type :=
 432             (Element => N.Element'Access,
 433              Control => (Controlled with Container'Unrestricted_Access))
 434          do
 435             B := B + 1;
 436             L := L + 1;
 437          end return;
 438       end;
 439    end Constant_Reference;
 440
 441    function Constant_Reference
 442      (Container : aliased Map;
 443       Key       : Key_Type) return Constant_Reference_Type
 444    is
 445       Node : constant Count_Type := Key_Ops.Find (Container, Key);
 446
 447    begin
 448       if Node = 0 then
 449          raise Constraint_Error with "key not in map";
 450       end if;
 451
 452       declare
 453          Cur  : Cursor := Find (Container, Key);
 454          pragma Unmodified (Cur);
 455
 456          N : Node_Type renames Container.Nodes (Node);
 457          B : Natural renames Cur.Container.Busy;
 458          L : Natural renames Cur.Container.Lock;
 459
 460       begin
 461          return R : constant Constant_Reference_Type :=
 462             (Element => N.Element'Access,
 463              Control => (Controlled with Container'Unrestricted_Access))
 464          do
 465             B := B + 1;
 466             L := L + 1;
 467          end return;
 468       end;
 469    end Constant_Reference;
 470
 471    --------------
 472    -- Contains --
 473    --------------
 474
 475    function Contains (Container : Map; Key : Key_Type) return Boolean is
 476    begin
 477       return Find (Container, Key) /= No_Element;
 478    end Contains;
 479
 480    ----------
 481    -- Copy --
 482    ----------
 483
 484    function Copy (Source : Map; Capacity : Count_Type := 0) return Map is
 485       C : Count_Type;
 486
 487    begin
 488       if Capacity = 0 then
 489          C := Source.Length;
 490
 491       elsif Capacity >= Source.Length then
 492          C := Capacity;
 493
 494       else
 495          raise Capacity_Error with "Capacity value too small";
 496       end if;
 497
 498       return Target : Map (Capacity => C) do
 499          Assign (Target => Target, Source => Source);
 500       end return;
 501    end Copy;
 502
 503    ------------
 504    -- Delete --
 505    ------------
 506
 507    procedure Delete (Container : in out Map; Position : in out Cursor) is
 508    begin
 509       if Position.Node = 0 then
 510          raise Constraint_Error with
 511            "Position cursor of Delete equals No_Element";
 512       end if;
 513
 514       if Position.Container /= Container'Unrestricted_Access then
 515          raise Program_Error with
 516            "Position cursor of Delete designates wrong map";
 517       end if;
 518
 519       pragma Assert (Vet (Container, Position.Node),
 520                      "Position cursor of Delete is bad");
 521
 522       Tree_Operations.Delete_Node_Sans_Free (Container, Position.Node);
 523       Tree_Operations.Free (Container, Position.Node);
 524
 525       Position := No_Element;
 526    end Delete;
 527
 528    procedure Delete (Container : in out Map; Key : Key_Type) is
 529       X : constant Count_Type := Key_Ops.Find (Container, Key);
 530
 531    begin
 532       if X = 0 then
 533          raise Constraint_Error with "key not in map";
 534       end if;
 535
 536       Tree_Operations.Delete_Node_Sans_Free (Container, X);
 537       Tree_Operations.Free (Container, X);
 538    end Delete;
 539
 540    ------------------
 541    -- Delete_First --
 542    ------------------
 543
 544    procedure Delete_First (Container : in out Map) is
 545       X : constant Count_Type := Container.First;
 546
 547    begin
 548       if X /= 0 then
 549          Tree_Operations.Delete_Node_Sans_Free (Container, X);
 550          Tree_Operations.Free (Container, X);
 551       end if;
 552    end Delete_First;
 553
 554    -----------------
 555    -- Delete_Last --
 556    -----------------
 557
 558    procedure Delete_Last (Container : in out Map) is
 559       X : constant Count_Type := Container.Last;
 560
 561    begin
 562       if X /= 0 then
 563          Tree_Operations.Delete_Node_Sans_Free (Container, X);
 564          Tree_Operations.Free (Container, X);
 565       end if;
 566    end Delete_Last;
 567
 568    -------------
 569    -- Element --
 570    -------------
 571
 572    function Element (Position : Cursor) return Element_Type is
 573    begin
 574       if Position.Node = 0 then
 575          raise Constraint_Error with
 576            "Position cursor of function Element equals No_Element";
 577       end if;
 578
 579       pragma Assert (Vet (Position.Container.all, Position.Node),
 580                      "Position cursor of function Element is bad");
 581
 582       return Position.Container.Nodes (Position.Node).Element;
 583    end Element;
 584
 585    function Element (Container : Map; Key : Key_Type) return Element_Type is
 586       Node : constant Count_Type := Key_Ops.Find (Container, Key);
 587    begin
 588       if Node = 0 then
 589          raise Constraint_Error with "key not in map";
 590       else
 591          return Container.Nodes (Node).Element;
 592       end if;
 593    end Element;
 594
 595    ---------------------
 596    -- Equivalent_Keys --
 597    ---------------------
 598
 599    function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
 600    begin
 601       if Left < Right
 602         or else Right < Left
 603       then
 604          return False;
 605       else
 606          return True;
 607       end if;
 608    end Equivalent_Keys;
 609
 610    -------------
 611    -- Exclude --
 612    -------------
 613
 614    procedure Exclude (Container : in out Map; Key : Key_Type) is
 615       X : constant Count_Type := Key_Ops.Find (Container, Key);
 616
 617    begin
 618       if X /= 0 then
 619          Tree_Operations.Delete_Node_Sans_Free (Container, X);
 620          Tree_Operations.Free (Container, X);
 621       end if;
 622    end Exclude;
 623
 624    --------------
 625    -- Finalize --
 626    --------------
 627
 628    procedure Finalize (Object : in out Iterator) is
 629    begin
 630       if Object.Container /= null then
 631          declare
 632             B : Natural renames Object.Container.all.Busy;
 633          begin
 634             B := B - 1;
 635          end;
 636       end if;
 637    end Finalize;
 638
 639    procedure Finalize (Control : in out Reference_Control_Type) is
 640    begin
 641       if Control.Container /= null then
 642          declare
 643             C : Map renames Control.Container.all;
 644             B : Natural renames C.Busy;
 645             L : Natural renames C.Lock;
 646          begin
 647             B := B - 1;
 648             L := L - 1;
 649          end;
 650
 651          Control.Container := null;
 652       end if;
 653    end Finalize;
 654
 655    ----------
 656    -- Find --
 657    ----------
 658
 659    function Find (Container : Map; Key : Key_Type) return Cursor is
 660       Node : constant Count_Type := Key_Ops.Find (Container, Key);
 661    begin
 662       if Node = 0 then
 663          return No_Element;
 664       else
 665          return Cursor'(Container'Unrestricted_Access, Node);
 666       end if;
 667    end Find;
 668
 669    -----------
 670    -- First --
 671    -----------
 672
 673    function First (Container : Map) return Cursor is
 674    begin
 675       if Container.First = 0 then
 676          return No_Element;
 677       else
 678          return Cursor'(Container'Unrestricted_Access, Container.First);
 679       end if;
 680    end First;
 681
 682    function First (Object : Iterator) return Cursor is
 683    begin
 684       --  The value of the iterator object's Node component influences the
 685       --  behavior of the First (and Last) selector function.
 686
 687       --  When the Node component is 0, this means the iterator object was
 688       --  constructed without a start expression, in which case the (forward)
 689       --  iteration starts from the (logical) beginning of the entire sequence
 690       --  of items (corresponding to Container.First, for a forward iterator).
 691
 692       --  Otherwise, this is iteration over a partial sequence of items. When
 693       --  the Node component is positive, the iterator object was constructed
 694       --  with a start expression, that specifies the position from which the
 695       --  (forward) partial iteration begins.
 696
 697       if Object.Node = 0 then
 698          return Bounded_Ordered_Maps.First (Object.Container.all);
 699       else
 700          return Cursor'(Object.Container, Object.Node);
 701       end if;
 702    end First;
 703
 704    -------------------
 705    -- First_Element --
 706    -------------------
 707
 708    function First_Element (Container : Map) return Element_Type is
 709    begin
 710       if Container.First = 0 then
 711          raise Constraint_Error with "map is empty";
 712       else
 713          return Container.Nodes (Container.First).Element;
 714       end if;
 715    end First_Element;
 716
 717    ---------------
 718    -- First_Key --
 719    ---------------
 720
 721    function First_Key (Container : Map) return Key_Type is
 722    begin
 723       if Container.First = 0 then
 724          raise Constraint_Error with "map is empty";
 725       else
 726          return Container.Nodes (Container.First).Key;
 727       end if;
 728    end First_Key;
 729
 730    -----------
 731    -- Floor --
 732    -----------
 733
 734    function Floor (Container : Map; Key : Key_Type) return Cursor is
 735       Node : constant Count_Type := Key_Ops.Floor (Container, Key);
 736    begin
 737       if Node = 0 then
 738          return No_Element;
 739       else
 740          return Cursor'(Container'Unrestricted_Access, Node);
 741       end if;
 742    end Floor;
 743
 744    -----------------
 745    -- Has_Element --
 746    -----------------
 747
 748    function Has_Element (Position : Cursor) return Boolean is
 749    begin
 750       return Position /= No_Element;
 751    end Has_Element;
 752
 753    -------------
 754    -- Include --
 755    -------------
 756
 757    procedure Include
 758      (Container : in out Map;
 759       Key       : Key_Type;
 760       New_Item  : Element_Type)
 761    is
 762       Position : Cursor;
 763       Inserted : Boolean;
 764
 765    begin
 766       Insert (Container, Key, New_Item, Position, Inserted);
 767
 768       if not Inserted then
 769          if Container.Lock > 0 then
 770             raise Program_Error with
 771               "attempt to tamper with elements (map is locked)";
 772          end if;
 773
 774          declare
 775             N : Node_Type renames Container.Nodes (Position.Node);
 776          begin
 777             N.Key := Key;
 778             N.Element := New_Item;
 779          end;
 780       end if;
 781    end Include;
 782
 783    ------------
 784    -- Insert --
 785    ------------
 786
 787    procedure Insert
 788      (Container : in out Map;
 789       Key       : Key_Type;
 790       New_Item  : Element_Type;
 791       Position  : out Cursor;
 792       Inserted  : out Boolean)
 793    is
 794       procedure Assign (Node : in out Node_Type);
 795       pragma Inline (Assign);
 796
 797       function New_Node return Count_Type;
 798       pragma Inline (New_Node);
 799
 800       procedure Insert_Post is
 801         new Key_Ops.Generic_Insert_Post (New_Node);
 802
 803       procedure Insert_Sans_Hint is
 804         new Key_Ops.Generic_Conditional_Insert (Insert_Post);
 805
 806       procedure Allocate is
 807          new Tree_Operations.Generic_Allocate (Assign);
 808
 809       ------------
 810       -- Assign --
 811       ------------
 812
 813       procedure Assign (Node : in out Node_Type) is
 814       begin
 815          Node.Key := Key;
 816          Node.Element := New_Item;
 817       end Assign;
 818
 819       --------------
 820       -- New_Node --
 821       --------------
 822
 823       function New_Node return Count_Type is
 824          Result : Count_Type;
 825       begin
 826          Allocate (Container, Result);
 827          return Result;
 828       end New_Node;
 829
 830    --  Start of processing for Insert
 831
 832    begin
 833       Insert_Sans_Hint
 834         (Container,
 835          Key,
 836          Position.Node,
 837          Inserted);
 838
 839       Position.Container := Container'Unrestricted_Access;
 840    end Insert;
 841
 842    procedure Insert
 843      (Container : in out Map;
 844       Key       : Key_Type;
 845       New_Item  : Element_Type)
 846    is
 847       Position : Cursor;
 848       pragma Unreferenced (Position);
 849
 850       Inserted : Boolean;
 851
 852    begin
 853       Insert (Container, Key, New_Item, Position, Inserted);
 854
 855       if not Inserted then
 856          raise Constraint_Error with "key already in map";
 857       end if;
 858    end Insert;
 859
 860    procedure Insert
 861      (Container : in out Map;
 862       Key       : Key_Type;
 863       Position  : out Cursor;
 864       Inserted  : out Boolean)
 865    is
 866       procedure Assign (Node : in out Node_Type);
 867       pragma Inline (Assign);
 868
 869       function New_Node return Count_Type;
 870       pragma Inline (New_Node);
 871
 872       procedure Insert_Post is
 873         new Key_Ops.Generic_Insert_Post (New_Node);
 874
 875       procedure Insert_Sans_Hint is
 876         new Key_Ops.Generic_Conditional_Insert (Insert_Post);
 877
 878       procedure Allocate is
 879          new Tree_Operations.Generic_Allocate (Assign);
 880
 881       ------------
 882       -- Assign --
 883       ------------
 884
 885       procedure Assign (Node : in out Node_Type) is
 886          New_Item : Element_Type;
 887          pragma Unmodified (New_Item);
 888          --  Default-initialized element (ok to reference, see below)
 889
 890       begin
 891          Node.Key := Key;
 892
 893       --  There is no explicit element provided, but in an instance the element
 894       --  type may be a scalar with a Default_Value aspect, or a composite type
 895       --  with such a scalar component or with defaulted components, so insert
 896       --  possibly initialized elements at the given position.
 897
 898          Node.Element := New_Item;
 899       end Assign;
 900
 901       --------------
 902       -- New_Node --
 903       --------------
 904
 905       function New_Node return Count_Type is
 906          Result : Count_Type;
 907       begin
 908          Allocate (Container, Result);
 909          return Result;
 910       end New_Node;
 911
 912    --  Start of processing for Insert
 913
 914    begin
 915       Insert_Sans_Hint
 916         (Container,
 917          Key,
 918          Position.Node,
 919          Inserted);
 920
 921       Position.Container := Container'Unrestricted_Access;
 922    end Insert;
 923
 924    --------------
 925    -- Is_Empty --
 926    --------------
 927
 928    function Is_Empty (Container : Map) return Boolean is
 929    begin
 930       return Container.Length = 0;
 931    end Is_Empty;
 932
 933    -------------------------
 934    -- Is_Greater_Key_Node --
 935    -------------------------
 936
 937    function Is_Greater_Key_Node
 938      (Left  : Key_Type;
 939       Right : Node_Type) return Boolean
 940    is
 941    begin
 942       --  Left > Right same as Right < Left
 943
 944       return Right.Key < Left;
 945    end Is_Greater_Key_Node;
 946
 947    ----------------------
 948    -- Is_Less_Key_Node --
 949    ----------------------
 950
 951    function Is_Less_Key_Node
 952      (Left  : Key_Type;
 953       Right : Node_Type) return Boolean
 954    is
 955    begin
 956       return Left < Right.Key;
 957    end Is_Less_Key_Node;
 958
 959    -------------
 960    -- Iterate --
 961    -------------
 962
 963    procedure Iterate
 964      (Container : Map;
 965       Process   : not null access procedure (Position : Cursor))
 966    is
 967       procedure Process_Node (Node : Count_Type);
 968       pragma Inline (Process_Node);
 969
 970       procedure Local_Iterate is
 971          new Tree_Operations.Generic_Iteration (Process_Node);
 972
 973       ------------------
 974       -- Process_Node --
 975       ------------------
 976
 977       procedure Process_Node (Node : Count_Type) is
 978       begin
 979          Process (Cursor'(Container'Unrestricted_Access, Node));
 980       end Process_Node;
 981
 982       B : Natural renames Container'Unrestricted_Access.all.Busy;
 983
 984    --  Start of processing for Iterate
 985
 986    begin
 987       B := B + 1;
 988
 989       begin
 990          Local_Iterate (Container);
 991       exception
 992          when others =>
 993             B := B - 1;
 994             raise;
 995       end;
 996
 997       B := B - 1;
 998    end Iterate;
 999
1000    function Iterate
1001      (Container : Map) return Map_Iterator_Interfaces.Reversible_Iterator'Class
1002    is
1003       B  : Natural renames Container'Unrestricted_Access.all.Busy;
1004
1005    begin
1006       --  The value of the Node component influences the behavior of the First
1007       --  and Last selector functions of the iterator object. When the Node
1008       --  component is 0 (as is the case here), this means the iterator object
1009       --  was constructed without a start expression. This is a complete
1010       --  iterator, meaning that the iteration starts from the (logical)
1011       --  beginning of the sequence of items.
1012
1013       --  Note: For a forward iterator, Container.First is the beginning, and
1014       --  for a reverse iterator, Container.Last is the beginning.
1015
1016       return It : constant Iterator :=
1017         (Limited_Controlled with
1018            Container => Container'Unrestricted_Access,
1019            Node      => 0)
1020       do
1021          B := B + 1;
1022       end return;
1023    end Iterate;
1024
1025    function Iterate
1026      (Container : Map;
1027       Start     : Cursor)
1028       return Map_Iterator_Interfaces.Reversible_Iterator'Class
1029    is
1030       B  : Natural renames Container'Unrestricted_Access.all.Busy;
1031
1032    begin
1033       --  Iterator was defined to behave the same as for a complete iterator,
1034       --  and iterate over the entire sequence of items. However, those
1035       --  semantics were unintuitive and arguably error-prone (it is too easy
1036       --  to accidentally create an endless loop), and so they were changed,
1037       --  per the ARG meeting in Denver on 2011/11. However, there was no
1038       --  consensus about what positive meaning this corner case should have,
1039       --  and so it was decided to simply raise an exception. This does imply,
1040       --  however, that it is not possible to use a partial iterator to specify
1041       --  an empty sequence of items.
1042
1043       if Start = No_Element then
1044          raise Constraint_Error with
1045            "Start position for iterator equals No_Element";
1046       end if;
1047
1048       if Start.Container /= Container'Unrestricted_Access then
1049          raise Program_Error with
1050            "Start cursor of Iterate designates wrong map";
1051       end if;
1052
1053       pragma Assert (Vet (Container, Start.Node),
1054                      "Start cursor of Iterate is bad");
1055
1056       --  The value of the Node component influences the behavior of the First
1057       --  and Last selector functions of the iterator object. When the Node
1058       --  component is positive (as is the case here), it means that this
1059       --  is a partial iteration, over a subset of the complete sequence of
1060       --  items. The iterator object was constructed with a start expression,
1061       --  indicating the position from which the iteration begins. (Note that
1062       --  the start position has the same value irrespective of whether this
1063       --  is a forward or reverse iteration.)
1064
1065       return It : constant Iterator :=
1066         (Limited_Controlled with
1067            Container => Container'Unrestricted_Access,
1068            Node      => Start.Node)
1069       do
1070          B := B + 1;
1071       end return;
1072    end Iterate;
1073
1074    ---------
1075    -- Key --
1076    ---------
1077
1078    function Key (Position : Cursor) return Key_Type is
1079    begin
1080       if Position.Node = 0 then
1081          raise Constraint_Error with
1082            "Position cursor of function Key equals No_Element";
1083       end if;
1084
1085       pragma Assert (Vet (Position.Container.all, Position.Node),
1086                      "Position cursor of function Key is bad");
1087
1088       return Position.Container.Nodes (Position.Node).Key;
1089    end Key;
1090
1091    ----------
1092    -- Last --
1093    ----------
1094
1095    function Last (Container : Map) return Cursor is
1096    begin
1097       if Container.Last = 0 then
1098          return No_Element;
1099       else
1100          return Cursor'(Container'Unrestricted_Access, Container.Last);
1101       end if;
1102    end Last;
1103
1104    function Last (Object : Iterator) return Cursor is
1105    begin
1106       --  The value of the iterator object's Node component influences the
1107       --  behavior of the Last (and First) selector function.
1108
1109       --  When the Node component is 0, this means the iterator object was
1110       --  constructed without a start expression, in which case the (reverse)
1111       --  iteration starts from the (logical) beginning of the entire sequence
1112       --  (corresponding to Container.Last, for a reverse iterator).
1113
1114       --  Otherwise, this is iteration over a partial sequence of items. When
1115       --  the Node component is positive, the iterator object was constructed
1116       --  with a start expression, that specifies the position from which the
1117       --  (reverse) partial iteration begins.
1118
1119       if Object.Node = 0 then
1120          return Bounded_Ordered_Maps.Last (Object.Container.all);
1121       else
1122          return Cursor'(Object.Container, Object.Node);
1123       end if;
1124    end Last;
1125
1126    ------------------
1127    -- Last_Element --
1128    ------------------
1129
1130    function Last_Element (Container : Map) return Element_Type is
1131    begin
1132       if Container.Last = 0 then
1133          raise Constraint_Error with "map is empty";
1134       else
1135          return Container.Nodes (Container.Last).Element;
1136       end if;
1137    end Last_Element;
1138
1139    --------------
1140    -- Last_Key --
1141    --------------
1142
1143    function Last_Key (Container : Map) return Key_Type is
1144    begin
1145       if Container.Last = 0 then
1146          raise Constraint_Error with "map is empty";
1147       else
1148          return Container.Nodes (Container.Last).Key;
1149       end if;
1150    end Last_Key;
1151
1152    ----------
1153    -- Left --
1154    ----------
1155
1156    function Left (Node : Node_Type) return Count_Type is
1157    begin
1158       return Node.Left;
1159    end Left;
1160
1161    ------------
1162    -- Length --
1163    ------------
1164
1165    function Length (Container : Map) return Count_Type is
1166    begin
1167       return Container.Length;
1168    end Length;
1169
1170    ----------
1171    -- Move --
1172    ----------
1173
1174    procedure Move (Target : in out Map; Source : in out Map) is
1175    begin
1176       if Target'Address = Source'Address then
1177          return;
1178       end if;
1179
1180       if Source.Busy > 0 then
1181          raise Program_Error with
1182            "attempt to tamper with cursors (container is busy)";
1183       end if;
1184
1185       Target.Assign (Source);
1186       Source.Clear;
1187    end Move;
1188
1189    ----------
1190    -- Next --
1191    ----------
1192
1193    procedure Next (Position : in out Cursor) is
1194    begin
1195       Position := Next (Position);
1196    end Next;
1197
1198    function Next (Position : Cursor) return Cursor is
1199    begin
1200       if Position = No_Element then
1201          return No_Element;
1202       end if;
1203
1204       pragma Assert (Vet (Position.Container.all, Position.Node),
1205                      "Position cursor of Next is bad");
1206
1207       declare
1208          M : Map renames Position.Container.all;
1209
1210          Node : constant Count_Type :=
1211            Tree_Operations.Next (M, Position.Node);
1212
1213       begin
1214          if Node = 0 then
1215             return No_Element;
1216          end if;
1217
1218          return Cursor'(Position.Container, Node);
1219       end;
1220    end Next;
1221
1222    function Next
1223      (Object   : Iterator;
1224       Position : Cursor) return Cursor
1225    is
1226    begin
1227       if Position.Container = null then
1228          return No_Element;
1229       end if;
1230
1231       if Position.Container /= Object.Container then
1232          raise Program_Error with
1233            "Position cursor of Next designates wrong map";
1234       end if;
1235
1236       return Next (Position);
1237    end Next;
1238
1239    ------------
1240    -- Parent --
1241    ------------
1242
1243    function Parent (Node : Node_Type) return Count_Type is
1244    begin
1245       return Node.Parent;
1246    end Parent;
1247
1248    --------------
1249    -- Previous --
1250    --------------
1251
1252    procedure Previous (Position : in out Cursor) is
1253    begin
1254       Position := Previous (Position);
1255    end Previous;
1256
1257    function Previous (Position : Cursor) return Cursor is
1258    begin
1259       if Position = No_Element then
1260          return No_Element;
1261       end if;
1262
1263       pragma Assert (Vet (Position.Container.all, Position.Node),
1264                      "Position cursor of Previous is bad");
1265
1266       declare
1267          M : Map renames Position.Container.all;
1268
1269          Node : constant Count_Type :=
1270            Tree_Operations.Previous (M, Position.Node);
1271
1272       begin
1273          if Node = 0 then
1274             return No_Element;
1275          end if;
1276
1277          return Cursor'(Position.Container, Node);
1278       end;
1279    end Previous;
1280
1281    function Previous
1282      (Object   : Iterator;
1283       Position : Cursor) return Cursor
1284    is
1285    begin
1286       if Position.Container = null then
1287          return No_Element;
1288       end if;
1289
1290       if Position.Container /= Object.Container then
1291          raise Program_Error with
1292            "Position cursor of Previous designates wrong map";
1293       end if;
1294
1295       return Previous (Position);
1296    end Previous;
1297
1298    -------------------
1299    -- Query_Element --
1300    -------------------
1301
1302    procedure Query_Element
1303      (Position : Cursor;
1304       Process  : not null access procedure (Key     : Key_Type;
1305                                             Element : Element_Type))
1306    is
1307    begin
1308       if Position.Node = 0 then
1309          raise Constraint_Error with
1310            "Position cursor of Query_Element equals No_Element";
1311       end if;
1312
1313       pragma Assert (Vet (Position.Container.all, Position.Node),
1314                      "Position cursor of Query_Element is bad");
1315
1316       declare
1317          M : Map renames Position.Container.all;
1318          N : Node_Type renames M.Nodes (Position.Node);
1319
1320          B : Natural renames M.Busy;
1321          L : Natural renames M.Lock;
1322
1323       begin
1324          B := B + 1;
1325          L := L + 1;
1326
1327          begin
1328             Process (N.Key, N.Element);
1329          exception
1330             when others =>
1331                L := L - 1;
1332                B := B - 1;
1333                raise;
1334          end;
1335
1336          L := L - 1;
1337          B := B - 1;
1338       end;
1339    end Query_Element;
1340
1341    ----------
1342    -- Read --
1343    ----------
1344
1345    procedure Read
1346      (Stream    : not null access Root_Stream_Type'Class;
1347       Container : out Map)
1348    is
1349       procedure Read_Element (Node : in out Node_Type);
1350       pragma Inline (Read_Element);
1351
1352       procedure Allocate is
1353          new Tree_Operations.Generic_Allocate (Read_Element);
1354
1355       procedure Read_Elements is
1356          new Tree_Operations.Generic_Read (Allocate);
1357
1358       ------------------
1359       -- Read_Element --
1360       ------------------
1361
1362       procedure Read_Element (Node : in out Node_Type) is
1363       begin
1364          Key_Type'Read (Stream, Node.Key);
1365          Element_Type'Read (Stream, Node.Element);
1366       end Read_Element;
1367
1368    --  Start of processing for Read
1369
1370    begin
1371       Read_Elements (Stream, Container);
1372    end Read;
1373
1374    procedure Read
1375      (Stream : not null access Root_Stream_Type'Class;
1376       Item   : out Cursor)
1377    is
1378    begin
1379       raise Program_Error with "attempt to stream map cursor";
1380    end Read;
1381
1382    procedure Read
1383      (Stream : not null access Root_Stream_Type'Class;
1384       Item   : out Reference_Type)
1385    is
1386    begin
1387       raise Program_Error with "attempt to stream reference";
1388    end Read;
1389
1390    procedure Read
1391      (Stream : not null access Root_Stream_Type'Class;
1392       Item   : out Constant_Reference_Type)
1393    is
1394    begin
1395       raise Program_Error with "attempt to stream reference";
1396    end Read;
1397
1398    ---------------
1399    -- Reference --
1400    ---------------
1401
1402    function Reference
1403      (Container : aliased in out Map;
1404       Position  : Cursor) return Reference_Type
1405    is
1406    begin
1407       if Position.Container = null then
1408          raise Constraint_Error with
1409            "Position cursor has no element";
1410       end if;
1411
1412       if Position.Container /= Container'Unrestricted_Access then
1413          raise Program_Error with
1414            "Position cursor designates wrong map";
1415       end if;
1416
1417       pragma Assert (Vet (Container, Position.Node),
1418                      "Position cursor in function Reference is bad");
1419
1420       declare
1421          N : Node_Type renames Container.Nodes (Position.Node);
1422          B : Natural   renames Container.Busy;
1423          L : Natural   renames Container.Lock;
1424       begin
1425          return R : constant Reference_Type :=
1426            (Element => N.Element'Access,
1427             Control => (Controlled with Container'Unrestricted_Access))
1428          do
1429             B := B + 1;
1430             L := L + 1;
1431          end return;
1432       end;
1433    end Reference;
1434
1435    function Reference
1436      (Container : aliased in out Map;
1437       Key       : Key_Type) return Reference_Type
1438    is
1439       Node : constant Count_Type := Key_Ops.Find (Container, Key);
1440
1441    begin
1442       if Node = 0 then
1443          raise Constraint_Error with "key not in map";
1444       end if;
1445
1446       declare
1447          N : Node_Type renames Container.Nodes (Node);
1448          B : Natural   renames Container.Busy;
1449          L : Natural   renames Container.Lock;
1450       begin
1451          return R : constant Reference_Type :=
1452            (Element => N.Element'Access,
1453             Control => (Controlled with Container'Unrestricted_Access))
1454          do
1455             B := B + 1;
1456             L := L + 1;
1457          end return;
1458       end;
1459    end Reference;
1460
1461    -------------
1462    -- Replace --
1463    -------------
1464
1465    procedure Replace
1466      (Container : in out Map;
1467       Key       : Key_Type;
1468       New_Item  : Element_Type)
1469    is
1470       Node : constant Count_Type := Key_Ops.Find (Container, Key);
1471
1472    begin
1473       if Node = 0 then
1474          raise Constraint_Error with "key not in map";
1475       end if;
1476
1477       if Container.Lock > 0 then
1478          raise Program_Error with
1479            "attempt to tamper with elements (map is locked)";
1480       end if;
1481
1482       declare
1483          N : Node_Type renames Container.Nodes (Node);
1484
1485       begin
1486          N.Key := Key;
1487          N.Element := New_Item;
1488       end;
1489    end Replace;
1490
1491    ---------------------
1492    -- Replace_Element --
1493    ---------------------
1494
1495    procedure Replace_Element
1496      (Container : in out Map;
1497       Position  : Cursor;
1498       New_Item  : Element_Type)
1499    is
1500    begin
1501       if Position.Node = 0 then
1502          raise Constraint_Error with
1503            "Position cursor of Replace_Element equals No_Element";
1504       end if;
1505
1506       if Position.Container /= Container'Unrestricted_Access then
1507          raise Program_Error with
1508            "Position cursor of Replace_Element designates wrong map";
1509       end if;
1510
1511       if Container.Lock > 0 then
1512          raise Program_Error with
1513            "attempt to tamper with elements (map is locked)";
1514       end if;
1515
1516       pragma Assert (Vet (Container, Position.Node),
1517                      "Position cursor of Replace_Element is bad");
1518
1519       Container.Nodes (Position.Node).Element := New_Item;
1520    end Replace_Element;
1521
1522    ---------------------
1523    -- Reverse_Iterate --
1524    ---------------------
1525
1526    procedure Reverse_Iterate
1527      (Container : Map;
1528       Process   : not null access procedure (Position : Cursor))
1529    is
1530       procedure Process_Node (Node : Count_Type);
1531       pragma Inline (Process_Node);
1532
1533       procedure Local_Reverse_Iterate is
1534          new Tree_Operations.Generic_Reverse_Iteration (Process_Node);
1535
1536       ------------------
1537       -- Process_Node --
1538       ------------------
1539
1540       procedure Process_Node (Node : Count_Type) is
1541       begin
1542          Process (Cursor'(Container'Unrestricted_Access, Node));
1543       end Process_Node;
1544
1545       B : Natural renames Container'Unrestricted_Access.all.Busy;
1546
1547    --  Start of processing for Reverse_Iterate
1548
1549    begin
1550       B := B + 1;
1551
1552       begin
1553          Local_Reverse_Iterate (Container);
1554       exception
1555          when others =>
1556             B := B - 1;
1557             raise;
1558       end;
1559
1560       B := B - 1;
1561    end Reverse_Iterate;
1562
1563    -----------
1564    -- Right --
1565    -----------
1566
1567    function Right (Node : Node_Type) return Count_Type is
1568    begin
1569       return Node.Right;
1570    end Right;
1571
1572    ---------------
1573    -- Set_Color --
1574    ---------------
1575
1576    procedure Set_Color
1577      (Node  : in out Node_Type;
1578       Color : Color_Type)
1579    is
1580    begin
1581       Node.Color := Color;
1582    end Set_Color;
1583
1584    --------------
1585    -- Set_Left --
1586    --------------
1587
1588    procedure Set_Left (Node : in out Node_Type; Left : Count_Type) is
1589    begin
1590       Node.Left := Left;
1591    end Set_Left;
1592
1593    ----------------
1594    -- Set_Parent --
1595    ----------------
1596
1597    procedure Set_Parent (Node : in out Node_Type; Parent : Count_Type) is
1598    begin
1599       Node.Parent := Parent;
1600    end Set_Parent;
1601
1602    ---------------
1603    -- Set_Right --
1604    ---------------
1605
1606    procedure Set_Right (Node : in out Node_Type; Right : Count_Type) is
1607    begin
1608       Node.Right := Right;
1609    end Set_Right;
1610
1611    --------------------
1612    -- Update_Element --
1613    --------------------
1614
1615    procedure Update_Element
1616      (Container : in out Map;
1617       Position  : Cursor;
1618       Process   : not null access procedure (Key     : Key_Type;
1619                                              Element : in out Element_Type))
1620    is
1621    begin
1622       if Position.Node = 0 then
1623          raise Constraint_Error with
1624            "Position cursor of Update_Element equals No_Element";
1625       end if;
1626
1627       if Position.Container /= Container'Unrestricted_Access then
1628          raise Program_Error with
1629            "Position cursor of Update_Element designates wrong map";
1630       end if;
1631
1632       pragma Assert (Vet (Container, Position.Node),
1633                      "Position cursor of Update_Element is bad");
1634
1635       declare
1636          N : Node_Type renames Container.Nodes (Position.Node);
1637          B : Natural renames Container.Busy;
1638          L : Natural renames Container.Lock;
1639
1640       begin
1641          B := B + 1;
1642          L := L + 1;
1643
1644          begin
1645             Process (N.Key, N.Element);
1646
1647          exception
1648             when others =>
1649                L := L - 1;
1650                B := B - 1;
1651                raise;
1652          end;
1653
1654          L := L - 1;
1655          B := B - 1;
1656       end;
1657    end Update_Element;
1658
1659    -----------
1660    -- Write --
1661    -----------
1662
1663    procedure Write
1664      (Stream    : not null access Root_Stream_Type'Class;
1665       Container : Map)
1666    is
1667       procedure Write_Node
1668         (Stream : not null access Root_Stream_Type'Class;
1669          Node   : Node_Type);
1670       pragma Inline (Write_Node);
1671
1672       procedure Write_Nodes is
1673          new Tree_Operations.Generic_Write (Write_Node);
1674
1675       ----------------
1676       -- Write_Node --
1677       ----------------
1678
1679       procedure Write_Node
1680         (Stream : not null access Root_Stream_Type'Class;
1681          Node   : Node_Type)
1682       is
1683       begin
1684          Key_Type'Write (Stream, Node.Key);
1685          Element_Type'Write (Stream, Node.Element);
1686       end Write_Node;
1687
1688    --  Start of processing for Write
1689
1690    begin
1691       Write_Nodes (Stream, Container);
1692    end Write;
1693
1694    procedure Write
1695      (Stream : not null access Root_Stream_Type'Class;
1696       Item   : Cursor)
1697    is
1698    begin
1699       raise Program_Error with "attempt to stream map cursor";
1700    end Write;
1701
1702    procedure Write
1703      (Stream : not null access Root_Stream_Type'Class;
1704       Item   : Reference_Type)
1705    is
1706    begin
1707       raise Program_Error with "attempt to stream reference";
1708    end Write;
1709
1710    procedure Write
1711      (Stream : not null access Root_Stream_Type'Class;
1712       Item   : Constant_Reference_Type)
1713    is
1714    begin
1715       raise Program_Error with "attempt to stream reference";
1716    end Write;
1717
1718 end Ada.Containers.Bounded_Ordered_Maps;