main/gcc/ada/a-cfhama.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --    A D A . C O N T A I N E R S . F O R M A L _ H A S H E D _ M A P S     --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2010-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
  28 with Ada.Containers.Hash_Tables.Generic_Bounded_Operations;
  29 pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Operations);
  30
  31 with Ada.Containers.Hash_Tables.Generic_Bounded_Keys;
  32 pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Keys);
  33
  34 with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers;
  35
  36 with System; use type System.Address;
  37
  38 package body Ada.Containers.Formal_Hashed_Maps is
  39    pragma SPARK_Mode (Off);
  40
  41    -----------------------
  42    -- Local Subprograms --
  43    -----------------------
  44
  45    --  All local subprograms require comments ???
  46
  47    function Equivalent_Keys
  48      (Key  : Key_Type;
  49       Node : Node_Type) return Boolean;
  50    pragma Inline (Equivalent_Keys);
  51
  52    procedure Free
  53      (HT : in out Map;
  54       X  : Count_Type);
  55
  56    generic
  57       with procedure Set_Element (Node : in out Node_Type);
  58    procedure Generic_Allocate
  59      (HT   : in out Map;
  60       Node : out Count_Type);
  61
  62    function Hash_Node (Node : Node_Type) return Hash_Type;
  63    pragma Inline (Hash_Node);
  64
  65    function Next (Node : Node_Type) return Count_Type;
  66    pragma Inline (Next);
  67
  68    procedure Set_Next (Node : in out Node_Type; Next : Count_Type);
  69    pragma Inline (Set_Next);
  70
  71    function Vet (Container : Map; Position : Cursor) return Boolean;
  72
  73    --------------------------
  74    -- Local Instantiations --
  75    --------------------------
  76
  77    package HT_Ops is
  78      new Hash_Tables.Generic_Bounded_Operations
  79        (HT_Types  => HT_Types,
  80         Hash_Node => Hash_Node,
  81         Next      => Next,
  82         Set_Next  => Set_Next);
  83
  84    package Key_Ops is
  85      new Hash_Tables.Generic_Bounded_Keys
  86        (HT_Types        => HT_Types,
  87         Next            => Next,
  88         Set_Next        => Set_Next,
  89         Key_Type        => Key_Type,
  90         Hash            => Hash,
  91         Equivalent_Keys => Equivalent_Keys);
  92
  93    ---------
  94    -- "=" --
  95    ---------
  96
  97    function "=" (Left, Right : Map) return Boolean is
  98    begin
  99       if Length (Left) /= Length (Right) then
 100          return False;
 101       end if;
 102
 103       if Length (Left) = 0 then
 104          return True;
 105       end if;
 106
 107       declare
 108          Node  : Count_Type;
 109          ENode : Count_Type;
 110
 111       begin
 112          Node := Left.First.Node;
 113          while Node /= 0 loop
 114             ENode := Find (Container => Right,
 115                            Key       => Left.Nodes (Node).Key).Node;
 116
 117             if ENode = 0 or else
 118               Right.Nodes (ENode).Element /= Left.Nodes (Node).Element
 119             then
 120                return False;
 121             end if;
 122
 123             Node := HT_Ops.Next (Left, Node);
 124          end loop;
 125
 126          return True;
 127       end;
 128    end "=";
 129
 130    ------------
 131    -- Assign --
 132    ------------
 133
 134    procedure Assign (Target : in out Map; Source : Map) is
 135       procedure Insert_Element (Source_Node : Count_Type);
 136       pragma Inline (Insert_Element);
 137
 138       procedure Insert_Elements is
 139         new HT_Ops.Generic_Iteration (Insert_Element);
 140
 141       --------------------
 142       -- Insert_Element --
 143       --------------------
 144
 145       procedure Insert_Element (Source_Node : Count_Type) is
 146          N : Node_Type renames Source.Nodes (Source_Node);
 147       begin
 148          Insert (Target, N.Key, N.Element);
 149       end Insert_Element;
 150
 151       --  Start of processing for Assign
 152
 153    begin
 154       if Target'Address = Source'Address then
 155          return;
 156       end if;
 157
 158       if Target.Capacity < Length (Source) then
 159          raise Constraint_Error with  -- correct exception ???
 160            "Source length exceeds Target capacity";
 161       end if;
 162
 163       Clear (Target);
 164
 165       Insert_Elements (Source);
 166    end Assign;
 167
 168    --------------
 169    -- Capacity --
 170    --------------
 171
 172    function Capacity (Container : Map) return Count_Type is
 173    begin
 174       return Container.Nodes'Length;
 175    end Capacity;
 176
 177    -----------
 178    -- Clear --
 179    -----------
 180
 181    procedure Clear (Container : in out Map) is
 182    begin
 183       HT_Ops.Clear (Container);
 184    end Clear;
 185
 186    --------------
 187    -- Contains --
 188    --------------
 189
 190    function Contains (Container : Map; Key : Key_Type) return Boolean is
 191    begin
 192       return Find (Container, Key) /= No_Element;
 193    end Contains;
 194
 195    ----------
 196    -- Copy --
 197    ----------
 198
 199    function Copy
 200      (Source   : Map;
 201       Capacity : Count_Type := 0) return Map
 202    is
 203       C      : constant Count_Type :=
 204         Count_Type'Max (Capacity, Source.Capacity);
 205       H      : Hash_Type;
 206       N      : Count_Type;
 207       Target : Map (C, Source.Modulus);
 208       Cu     : Cursor;
 209
 210    begin
 211       if 0 < Capacity and then Capacity < Source.Capacity then
 212          raise Capacity_Error;
 213       end if;
 214
 215       Target.Length := Source.Length;
 216       Target.Free := Source.Free;
 217
 218       H := 1;
 219       while H <= Source.Modulus loop
 220          Target.Buckets (H) := Source.Buckets (H);
 221          H := H + 1;
 222       end loop;
 223
 224       N := 1;
 225       while N <= Source.Capacity loop
 226          Target.Nodes (N) := Source.Nodes (N);
 227          N := N + 1;
 228       end loop;
 229
 230       while N <= C loop
 231          Cu := (Node => N);
 232          Free (Target, Cu.Node);
 233          N := N + 1;
 234       end loop;
 235
 236       return Target;
 237    end Copy;
 238
 239    ---------------------
 240    -- Current_To_Last --
 241    ---------------------
 242
 243    function Current_To_Last (Container : Map; Current : Cursor) return Map is
 244       Curs : Cursor := First (Container);
 245       C    : Map (Container.Capacity, Container.Modulus) :=
 246                Copy (Container, Container.Capacity);
 247       Node : Count_Type;
 248
 249    begin
 250       if Curs = No_Element then
 251          Clear (C);
 252          return C;
 253
 254       elsif Current /= No_Element and not Has_Element (Container, Current) then
 255          raise Constraint_Error;
 256
 257       else
 258          while Curs.Node /= Current.Node loop
 259             Node := Curs.Node;
 260             Delete (C, Curs);
 261             Curs := Next (Container, (Node => Node));
 262          end loop;
 263
 264          return C;
 265       end if;
 266    end Current_To_Last;
 267
 268    ---------------------
 269    -- Default_Modulus --
 270    ---------------------
 271
 272    function Default_Modulus (Capacity : Count_Type) return Hash_Type is
 273    begin
 274       return To_Prime (Capacity);
 275    end Default_Modulus;
 276
 277    ------------
 278    -- Delete --
 279    ------------
 280
 281    procedure Delete (Container : in out Map; Key : Key_Type) is
 282       X : Count_Type;
 283
 284    begin
 285       Key_Ops.Delete_Key_Sans_Free (Container, Key, X);
 286
 287       if X = 0 then
 288          raise Constraint_Error with "attempt to delete key not in map";
 289       end if;
 290
 291       Free (Container, X);
 292    end Delete;
 293
 294    procedure Delete (Container : in out Map; Position : in out Cursor) is
 295    begin
 296       if not Has_Element (Container, Position) then
 297          raise Constraint_Error with
 298            "Position cursor of Delete has no element";
 299       end if;
 300
 301       pragma Assert (Vet (Container, Position), "bad cursor in Delete");
 302
 303       HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
 304
 305       Free (Container, Position.Node);
 306    end Delete;
 307
 308    -------------
 309    -- Element --
 310    -------------
 311
 312    function Element (Container : Map; Key : Key_Type) return Element_Type is
 313       Node : constant Count_Type := Find (Container, Key).Node;
 314
 315    begin
 316       if Node = 0 then
 317          raise Constraint_Error with
 318            "no element available because key not in map";
 319       end if;
 320
 321       return Container.Nodes (Node).Element;
 322    end Element;
 323
 324    function Element (Container : Map; Position : Cursor) return Element_Type is
 325    begin
 326       if not Has_Element (Container, Position) then
 327          raise Constraint_Error with "Position cursor equals No_Element";
 328       end if;
 329
 330       pragma Assert (Vet (Container, Position),
 331                      "bad cursor in function Element");
 332
 333       return Container.Nodes (Position.Node).Element;
 334    end Element;
 335
 336    ---------------------
 337    -- Equivalent_Keys --
 338    ---------------------
 339
 340    function Equivalent_Keys
 341      (Key  : Key_Type;
 342       Node : Node_Type) return Boolean
 343    is
 344    begin
 345       return Equivalent_Keys (Key, Node.Key);
 346    end Equivalent_Keys;
 347
 348    function Equivalent_Keys
 349      (Left   : Map;
 350       CLeft  : Cursor;
 351       Right  : Map;
 352       CRight : Cursor) return Boolean
 353    is
 354    begin
 355       if not Has_Element (Left, CLeft) then
 356          raise Constraint_Error with
 357            "Left cursor of Equivalent_Keys has no element";
 358       end if;
 359
 360       if not Has_Element (Right, CRight) then
 361          raise Constraint_Error with
 362            "Right cursor of Equivalent_Keys has no element";
 363       end if;
 364
 365       pragma Assert (Vet (Left, CLeft),
 366                      "Left cursor of Equivalent_Keys is bad");
 367       pragma Assert (Vet (Right, CRight),
 368                      "Right cursor of Equivalent_Keys is bad");
 369
 370       declare
 371          LN : Node_Type renames Left.Nodes (CLeft.Node);
 372          RN : Node_Type renames Right.Nodes (CRight.Node);
 373       begin
 374          return Equivalent_Keys (LN.Key, RN.Key);
 375       end;
 376    end Equivalent_Keys;
 377
 378    function Equivalent_Keys
 379      (Left  : Map;
 380       CLeft : Cursor;
 381       Right : Key_Type) return Boolean
 382    is
 383    begin
 384       if not Has_Element (Left, CLeft) then
 385          raise Constraint_Error with
 386            "Left cursor of Equivalent_Keys has no element";
 387       end if;
 388
 389       pragma Assert (Vet (Left, CLeft),
 390                      "Left cursor in Equivalent_Keys is bad");
 391
 392       declare
 393          LN : Node_Type renames Left.Nodes (CLeft.Node);
 394       begin
 395          return Equivalent_Keys (LN.Key, Right);
 396       end;
 397    end Equivalent_Keys;
 398
 399    function Equivalent_Keys
 400      (Left   : Key_Type;
 401       Right  : Map;
 402       CRight : Cursor) return Boolean
 403    is
 404    begin
 405       if Has_Element (Right, CRight) then
 406          raise Constraint_Error with
 407            "Right cursor of Equivalent_Keys has no element";
 408       end if;
 409
 410       pragma Assert (Vet (Right, CRight),
 411                      "Right cursor of Equivalent_Keys is bad");
 412
 413       declare
 414          RN : Node_Type renames Right.Nodes (CRight.Node);
 415
 416       begin
 417          return Equivalent_Keys (Left, RN.Key);
 418       end;
 419    end Equivalent_Keys;
 420
 421    -------------
 422    -- Exclude --
 423    -------------
 424
 425    procedure Exclude (Container : in out Map; Key : Key_Type) is
 426       X : Count_Type;
 427    begin
 428       Key_Ops.Delete_Key_Sans_Free (Container, Key, X);
 429       Free (Container, X);
 430    end Exclude;
 431
 432    ----------
 433    -- Find --
 434    ----------
 435
 436    function Find (Container : Map; Key : Key_Type) return Cursor is
 437       Node : constant Count_Type := Key_Ops.Find (Container, Key);
 438
 439    begin
 440       if Node = 0 then
 441          return No_Element;
 442       end if;
 443
 444       return (Node => Node);
 445    end Find;
 446
 447    -----------
 448    -- First --
 449    -----------
 450
 451    function First (Container : Map) return Cursor is
 452       Node : constant Count_Type := HT_Ops.First (Container);
 453
 454    begin
 455       if Node = 0 then
 456          return No_Element;
 457       end if;
 458
 459       return (Node => Node);
 460    end First;
 461
 462    -----------------------
 463    -- First_To_Previous --
 464    -----------------------
 465
 466    function First_To_Previous
 467      (Container : Map;
 468       Current : Cursor) return Map is
 469       Curs : Cursor;
 470       C    : Map (Container.Capacity, Container.Modulus) :=
 471                Copy (Container, Container.Capacity);
 472       Node : Count_Type;
 473
 474    begin
 475       Curs := Current;
 476
 477       if Curs = No_Element then
 478          return C;
 479
 480       elsif not Has_Element (Container, Curs) then
 481          raise Constraint_Error;
 482
 483       else
 484          while Curs.Node /= 0 loop
 485             Node := Curs.Node;
 486             Delete (C, Curs);
 487             Curs := Next (Container, (Node => Node));
 488          end loop;
 489
 490          return C;
 491       end if;
 492    end First_To_Previous;
 493
 494    ----------
 495    -- Free --
 496    ----------
 497
 498    procedure Free (HT : in out Map; X : Count_Type) is
 499    begin
 500       HT.Nodes (X).Has_Element := False;
 501       HT_Ops.Free (HT, X);
 502    end Free;
 503
 504    ----------------------
 505    -- Generic_Allocate --
 506    ----------------------
 507
 508    procedure Generic_Allocate (HT : in out Map; Node : out Count_Type) is
 509
 510       procedure Allocate is
 511         new HT_Ops.Generic_Allocate (Set_Element);
 512
 513    begin
 514       Allocate (HT, Node);
 515       HT.Nodes (Node).Has_Element := True;
 516    end Generic_Allocate;
 517
 518    -----------------
 519    -- Has_Element --
 520    -----------------
 521
 522    function Has_Element (Container : Map; Position : Cursor) return Boolean is
 523    begin
 524       if Position.Node = 0
 525         or else not Container.Nodes (Position.Node).Has_Element
 526       then
 527          return False;
 528       else
 529          return True;
 530       end if;
 531    end Has_Element;
 532
 533    ---------------
 534    -- Hash_Node --
 535    ---------------
 536
 537    function Hash_Node (Node : Node_Type) return Hash_Type is
 538    begin
 539       return Hash (Node.Key);
 540    end Hash_Node;
 541
 542    -------------
 543    -- Include --
 544    -------------
 545
 546    procedure Include
 547      (Container : in out Map;
 548       Key       : Key_Type;
 549       New_Item  : Element_Type)
 550    is
 551       Position : Cursor;
 552       Inserted : Boolean;
 553
 554    begin
 555       Insert (Container, Key, New_Item, Position, Inserted);
 556
 557       if not Inserted then
 558          declare
 559             N : Node_Type renames Container.Nodes (Position.Node);
 560          begin
 561             N.Key := Key;
 562             N.Element := New_Item;
 563          end;
 564       end if;
 565    end Include;
 566
 567    ------------
 568    -- Insert --
 569    ------------
 570
 571    procedure Insert
 572      (Container : in out Map;
 573       Key       : Key_Type;
 574       New_Item  : Element_Type;
 575       Position  : out Cursor;
 576       Inserted  : out Boolean)
 577    is
 578       procedure Assign_Key (Node : in out Node_Type);
 579       pragma Inline (Assign_Key);
 580
 581       function New_Node return Count_Type;
 582       pragma Inline (New_Node);
 583
 584       procedure Local_Insert is
 585         new Key_Ops.Generic_Conditional_Insert (New_Node);
 586
 587       procedure Allocate is
 588         new Generic_Allocate (Assign_Key);
 589
 590       -----------------
 591       --  Assign_Key --
 592       -----------------
 593
 594       procedure Assign_Key (Node : in out Node_Type) is
 595       begin
 596          Node.Key := Key;
 597          Node.Element := New_Item;
 598       end Assign_Key;
 599
 600       --------------
 601       -- New_Node --
 602       --------------
 603
 604       function New_Node return Count_Type is
 605          Result : Count_Type;
 606       begin
 607          Allocate (Container, Result);
 608          return Result;
 609       end New_Node;
 610
 611    --  Start of processing for Insert
 612
 613    begin
 614       Local_Insert (Container, Key, Position.Node, Inserted);
 615    end Insert;
 616
 617    procedure Insert
 618      (Container : in out Map;
 619       Key       : Key_Type;
 620       New_Item  : Element_Type)
 621    is
 622       Position : Cursor;
 623       pragma Unreferenced (Position);
 624
 625       Inserted : Boolean;
 626
 627    begin
 628       Insert (Container, Key, New_Item, Position, Inserted);
 629
 630       if not Inserted then
 631          raise Constraint_Error with
 632            "attempt to insert key already in map";
 633       end if;
 634    end Insert;
 635
 636    --------------
 637    -- Is_Empty --
 638    --------------
 639
 640    function Is_Empty (Container : Map) return Boolean is
 641    begin
 642       return Length (Container) = 0;
 643    end Is_Empty;
 644
 645    ---------
 646    -- Key --
 647    ---------
 648
 649    function Key (Container : Map; Position : Cursor) return Key_Type is
 650    begin
 651       if not Has_Element (Container, Position) then
 652          raise Constraint_Error with
 653            "Position cursor of function Key has no element";
 654       end if;
 655
 656       pragma Assert (Vet (Container, Position), "bad cursor in function Key");
 657
 658       return Container.Nodes (Position.Node).Key;
 659    end Key;
 660
 661    ------------
 662    -- Length --
 663    ------------
 664
 665    function Length (Container : Map) return Count_Type is
 666    begin
 667       return Container.Length;
 668    end Length;
 669
 670    ----------
 671    -- Move --
 672    ----------
 673
 674    procedure Move
 675      (Target : in out Map;
 676       Source : in out Map)
 677    is
 678       NN   : HT_Types.Nodes_Type renames Source.Nodes;
 679       X, Y : Count_Type;
 680
 681    begin
 682       if Target'Address = Source'Address then
 683          return;
 684       end if;
 685
 686       if Target.Capacity < Length (Source) then
 687          raise Constraint_Error with  -- ???
 688            "Source length exceeds Target capacity";
 689       end if;
 690
 691       Clear (Target);
 692
 693       if Source.Length = 0 then
 694          return;
 695       end if;
 696
 697       X := HT_Ops.First (Source);
 698       while X /= 0 loop
 699          Insert (Target, NN (X).Key, NN (X).Element);  -- optimize???
 700
 701          Y := HT_Ops.Next (Source, X);
 702
 703          HT_Ops.Delete_Node_Sans_Free (Source, X);
 704          Free (Source, X);
 705
 706          X := Y;
 707       end loop;
 708    end Move;
 709
 710    ----------
 711    -- Next --
 712    ----------
 713
 714    function Next (Node : Node_Type) return Count_Type is
 715    begin
 716       return Node.Next;
 717    end Next;
 718
 719    function Next (Container : Map; Position : Cursor) return Cursor is
 720    begin
 721       if Position.Node = 0 then
 722          return No_Element;
 723       end if;
 724
 725       if not Has_Element (Container, Position) then
 726          raise Constraint_Error
 727            with "Position has no element";
 728       end if;
 729
 730       pragma Assert (Vet (Container, Position), "bad cursor in function Next");
 731
 732       declare
 733          Node : constant Count_Type := HT_Ops.Next (Container, Position.Node);
 734
 735       begin
 736          if Node = 0 then
 737             return No_Element;
 738          end if;
 739
 740          return (Node => Node);
 741       end;
 742    end Next;
 743
 744    procedure Next (Container : Map; Position : in out Cursor) is
 745    begin
 746       Position := Next (Container, Position);
 747    end Next;
 748
 749    -------------
 750    -- Overlap --
 751    -------------
 752
 753    function Overlap (Left, Right : Map) return Boolean is
 754       Left_Node  : Count_Type;
 755       Left_Nodes : Nodes_Type renames Left.Nodes;
 756
 757    begin
 758       if Length (Right) = 0 or Length (Left) = 0 then
 759          return False;
 760       end if;
 761
 762       if Left'Address = Right'Address then
 763          return True;
 764       end if;
 765
 766       Left_Node := First (Left).Node;
 767       while Left_Node /= 0 loop
 768          declare
 769             N : Node_Type renames Left_Nodes (Left_Node);
 770             E : Key_Type renames N.Key;
 771          begin
 772             if Find (Right, E).Node /= 0 then
 773                return True;
 774             end if;
 775          end;
 776
 777          Left_Node := HT_Ops.Next (Left, Left_Node);
 778       end loop;
 779
 780       return False;
 781    end Overlap;
 782
 783    -------------
 784    -- Replace --
 785    -------------
 786
 787    procedure Replace
 788      (Container : in out Map;
 789       Key       : Key_Type;
 790       New_Item  : Element_Type)
 791    is
 792       Node : constant Count_Type := Key_Ops.Find (Container, Key);
 793
 794    begin
 795       if Node = 0 then
 796          raise Constraint_Error with
 797            "attempt to replace key not in map";
 798       end if;
 799
 800       declare
 801          N : Node_Type renames Container.Nodes (Node);
 802       begin
 803          N.Key := Key;
 804          N.Element := New_Item;
 805       end;
 806    end Replace;
 807
 808    ---------------------
 809    -- Replace_Element --
 810    ---------------------
 811
 812    procedure Replace_Element
 813      (Container : in out Map;
 814       Position  : Cursor;
 815       New_Item  : Element_Type)
 816    is
 817    begin
 818       if not Has_Element (Container, Position) then
 819          raise Constraint_Error with
 820            "Position cursor of Replace_Element has no element";
 821       end if;
 822
 823       pragma Assert (Vet (Container, Position),
 824                      "bad cursor in Replace_Element");
 825
 826       Container.Nodes (Position.Node).Element := New_Item;
 827    end Replace_Element;
 828
 829    ----------------------
 830    -- Reserve_Capacity --
 831    ----------------------
 832
 833    procedure Reserve_Capacity
 834      (Container : in out Map;
 835       Capacity  : Count_Type)
 836    is
 837    begin
 838       if Capacity > Container.Capacity then
 839          raise Capacity_Error with "requested capacity is too large";
 840       end if;
 841    end Reserve_Capacity;
 842
 843    --------------
 844    -- Set_Next --
 845    --------------
 846
 847    procedure Set_Next (Node : in out Node_Type; Next : Count_Type) is
 848    begin
 849       Node.Next := Next;
 850    end Set_Next;
 851
 852    ------------------
 853    -- Strict_Equal --
 854    ------------------
 855
 856    function Strict_Equal (Left, Right : Map) return Boolean is
 857       CuL : Cursor := First (Left);
 858       CuR : Cursor := First (Right);
 859
 860    begin
 861       if Length (Left) /= Length (Right) then
 862          return False;
 863       end if;
 864
 865       while CuL.Node /= 0 or else CuR.Node /= 0 loop
 866          if CuL.Node /= CuR.Node
 867            or else
 868              Left.Nodes (CuL.Node).Element /= Right.Nodes (CuR.Node).Element
 869            or else Left.Nodes (CuL.Node).Key /= Right.Nodes (CuR.Node).Key
 870          then
 871             return False;
 872          end if;
 873
 874          CuL := Next (Left, CuL);
 875          CuR := Next (Right, CuR);
 876       end loop;
 877
 878       return True;
 879    end Strict_Equal;
 880
 881    ---------
 882    -- Vet --
 883    ---------
 884
 885    function Vet (Container : Map; Position : Cursor) return Boolean is
 886    begin
 887       if Position.Node = 0 then
 888          return True;
 889       end if;
 890
 891       declare
 892          X : Count_Type;
 893
 894       begin
 895          if Container.Length = 0 then
 896             return False;
 897          end if;
 898
 899          if Container.Capacity = 0 then
 900             return False;
 901          end if;
 902
 903          if Container.Buckets'Length = 0 then
 904             return False;
 905          end if;
 906
 907          if Position.Node > Container.Capacity then
 908             return False;
 909          end if;
 910
 911          if Container.Nodes (Position.Node).Next = Position.Node then
 912             return False;
 913          end if;
 914
 915          X := Container.Buckets
 916            (Key_Ops.Index (Container, Container.Nodes (Position.Node).Key));
 917
 918          for J in 1 .. Container.Length loop
 919             if X = Position.Node then
 920                return True;
 921             end if;
 922
 923             if X = 0 then
 924                return False;
 925             end if;
 926
 927             if X = Container.Nodes (X).Next then
 928
 929                --  Prevent unnecessary looping
 930
 931                return False;
 932             end if;
 933
 934             X := Container.Nodes (X).Next;
 935          end loop;
 936
 937          return False;
 938       end;
 939    end Vet;
 940
 941 end Ada.Containers.Formal_Hashed_Maps;