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