-- Implementation of Leftist_Heap

with Unchecked_Deallocation;
package body Leftist_Heap is

    procedure Initialize( H: in out Priority_Queue ) is
    begin
        null;
    end Initialize;

    procedure Finalize( H: in out Priority_Queue ) is
    begin
        Make_Empty( H );
    end Finalize;

    procedure Dispose is new Unchecked_Deallocation( Tree_Node, Tree_Ptr );
    function Merge( H1, H2: Tree_Ptr ) return Tree_Ptr;
    function Merge1( H1, H2: Tree_Ptr ) return Tree_Ptr;
    procedure Swap( A, B: in out Tree_Ptr );

    -- VISIBLE ROUTINES

    -- Remove minimum item from Priority_Queue H
    -- Place it in X; raise Underflow if H was empty
    procedure Delete_Min( X: out Element_Type; H: in out Priority_Queue ) is
        Left_Heap, Right_Heap : Tree_Ptr;
    begin
        if Is_Empty( H ) then
            raise Underflow;
        end if;

        X := H.Root.Element;
        Left_Heap := H.Root.Left;
        Right_Heap := H.Root.Right;
        Dispose( H.Root );
        H.Root := Merge( Left_Heap, Right_Heap );
    end Delete_Min;

    -- Return minimum item in Priority_Queue H
    -- Raise Underflow if H was empty
    function Find_Min( H: Priority_Queue ) return Element_Type is
    begin
        if Is_Empty( H ) then
            raise Underflow;
        end if;

        return H.Root.Element;
    end Find_Min;

    -- Insert new item X into Priority_Queue H
    procedure Insert( X: Element_Type; H: in out Priority_Queue ) is
    begin
        H.Root := Merge( new Tree_Node'( X, null, null, 0 ), H.Root );
    end Insert;

    -- Return true if Priority_Queue H is empty, false otherwise
    function Is_Empty( H : Priority_Queue ) return Boolean is
    begin
        return H.Root = null;
    end Is_Empty;

    -- Make Priority_Queue H empty, and dispose nodes
    -- Calls hidden recursive routine
    procedure Make_Empty( H: in out Priority_Queue ) is
        procedure Make_Empty( T: in out Tree_Ptr ) is
        begin
            if T /= null then
                Make_Empty( T.Left );
                Make_Empty( T.Right );
                Dispose( T );
            end if;
        end Make_Empty;
    begin
        Make_Empty( H.Root );
    end Make_Empty;

    -- Merge two Priority_Queues H1 and H2 into Result
    -- H1 and H2 are set to be empty after the Merge
    -- Former items in Result are reclaimed
    -- Aliasing tests are performed to make sure all
    -- three Priority_Queue objects are distinct.
    -- Note that this test will also disallow a
    -- Merge in which two of the three objects are empty
    procedure Merge( H1: in out Priority_Queue;
                     H2: in out Priority_Queue;
                 Result: in out Priority_Queue ) is
    begin
        if H1.Root = H2.Root or else H1.Root = Result.Root or else
                                     H2.Root = Result.Root then
            raise Illegal_Merge;
        else
            Make_Empty( Result );
            Result.Root := Merge( H1.Root, H2.Root );
            H1.Root := null;
            H2.Root := null;
        end if;
    end Merge;
	
    -- PRIVATE routines that do most of the work

    -- Return the result of merging two leftist heaps rooted at
    -- H1 and H2. H1 has smaller root, H1 and H2 are not null 
    function Merge1( H1, H2: Tree_Ptr ) return Tree_Ptr is
    begin
        if H1.Left = null then	-- Single node.  other fields 
            H1.Left := H2;	-- Already correctly set 
        else
            H1.Right := Merge( H1.Right, H2 );
            if H1.Left.Npl < H1.Right.Npl then
                Swap( H1.Left, H1.Right );
            end if;

            H1.Npl := H1.Right.Npl + 1;
        end if;

        return H1;
    end Merge1;

    -- Return the result of merging two leftist heaps rooted at
    -- H1 and H2. Calls Merge1 after handling degenerate cases
    -- and ensuring that H1 has smaller root
    function Merge( H1, H2: Tree_Ptr ) return Tree_Ptr is
    begin
        if H1 = null then
            return H2;
        elsif H2 = null then
            return H1;
        elsif H2.Element > H1.Element then
            return Merge1( H1, H2 );
        else
            return Merge1( H2, H1 );
        end if;
    end Merge;

    -- Swap two pointers
    procedure Swap( A, B: in out Tree_Ptr ) is
        Tmp : Tree_Ptr := A;
    begin
        A := B;
        B := Tmp;
    end Swap;

end Leftist_Heap;