--::::::::::
--heaplpba.adb
--::::::::::
with Unchecked_Deallocation;
package body Heap_LPBase is

procedure Free is new Unchecked_Deallocation (Heap_Array, Heap_Pntr);

procedure Initialize (Heap: in out Heap_Type) is
   begin -- Initialize
      Heap.Size := 0;
      Heap.Data := new Heap_Array (1..Heap.Max_Size);
   end Initialize;
   --------------------------------------------------
procedure Finalize (Heap: in out Heap_Type) is
   begin -- Finalize
      for i in 1..Heap.Size loop
         Finalize (Heap.Data.all(i));
      end loop;
      Heap.Size := 0;
      Free (Heap.Data);
   end Finalize;
   --------------------------------------------------
procedure Insert (Heap  : in out Heap_Type;
                  Object: in out Object_Type) is
   Parent: natural := (Heap.Size + 1) / 2 ;
   Child : natural := Heap.Size + 1 ;
   begin
      if Heap.Size = Heap.Max_Size then
          raise Heap_Overflow ;
        else
          Heap.Size := Heap.Size + 1 ;
          Initialize (Heap.Data.all(Heap.Size));
          while (Parent > 0) and then
                not ((Heap.Data.all(Parent) >= Object)) loop
             Swap (Heap.Data.all(Parent), Heap.Data.all (Child)) ;
             Child := Parent ;
             Parent:= Parent / 2 ;
          end loop;
          Swap (Object, Heap.Data.all(Child) ) ;
      end if;
   end Insert ;
   --------------------------------------------------
procedure Remove_Root (Heap  : in out Heap_Type ;
                       Object: in out Object_Type ) is
   New_Node : Object_Type ;
   procedure Sift_Down (Heap   : in out Heap_Type ;
                        Object : in out Object_Type ) is
      Parent   : positive := 1 ;
      Child    : positive ;
      Continue : boolean  := true ;
      begin -- Sift_Down
         while Continue loop
            Child := 2*Parent ;
            if Child > Heap.Size then
                Continue := false ;
              else
                if ((Child+1) <= Heap.Size) and then
                    Heap.Data.all(Child+1) >= Heap.Data.all(Child) then
                    Child := Child+1 ;
                end if ;
                if Object >= Heap.Data.all(Child) then
                    Continue := false ;
                  else
                    Swap (Heap.Data.all(Child), Heap.Data.all(Parent) );
                    Parent := Child ;
                end if;
            end if;
         end loop;
         Swap (Object, Heap.Data.all (Parent) );
      end Sift_Down ;
      -----------------------------------------------
   begin -- Remove_Root
      if Heap.Size = 0 then
          raise Heap_Underflow ;
        else
          Initialize (New_Node);
          Swap (Heap.Data.all(1), Object) ;
          Swap (Heap.Data.all(Heap.Size), New_Node) ;
          Finalize (Heap.Data.all (Heap.Size));
          Heap.Size := Heap.Size - 1 ;
          if Heap.Size /= 0  then
              Sift_Down (Heap, New_Node) ;
          end if;
          Finalize (New_Node);
      end if ;
   end Remove_Root ;
   --------------------------------------------------
function Empty (Heap: Heap_Type ) return boolean is
   begin
      return Heap.Size = 0 ;
   end Empty ;
   --------------------------------------------------
function No_Of_Objects (Heap: Heap_Type) return natural is
   begin
      return Heap.Size ;
   end No_Of_Objects ;
   --------------------------------------------------

end Heap_LPBase;