-- Ada implementation of maxiphobic heaps as described in
--   Alternatives to Two Classic Data Structures
--   Chris Okasaki
--   SIGCSE 2005
--
-- Implements mergeable priority queues of integers.
-- Can easily be adapted to other key types.

WITH Ada.Unchecked_Deallocation;

PACKAGE BODY Maxiphobic IS

   PROCEDURE Deallocate IS
      NEW Ada.Unchecked_Deallocation(Tree_Node, Tree_Ptr);

   FUNCTION Size(T : Tree_Ptr) RETURN Natural IS
   BEGIN
      IF T = NULL THEN
         RETURN 0;
      ELSE
         RETURN T.Size;
      END IF;
   END Size;

   PROCEDURE Swap(T1, T2 : IN OUT Tree_Ptr) IS
      Tmp : Tree_Ptr;
   BEGIN
      Tmp := T1;
      T1 := T2;
      T2 := Tmp;
   END Swap;

   FUNCTION Merge(Tree1, Tree2 : Tree_Ptr) RETURN Tree_Ptr IS
      T1 : Tree_Ptr := Tree1;
      T2 : Tree_Ptr := Tree2;
      A,B,C : Tree_Ptr;
   BEGIN
      IF T1 = NULL THEN
         RETURN T2;
      ELSIF T2 = NULL THEN
         RETURN T1;
      ELSE -- T1 and T2 both non-empty

         -- force T1 to have smaller root
         IF T2.Value < T1.Value THEN
            Swap(T1,T2);
         END IF;

         -- calculate size of merged tree
         T1.Size := T1.Size + T2.Size;

         -- get the three subtrees
         A := T1.Left;
         B := T1.Right;
         C := T2;

         -- force A to be biggest of the three subtrees
         IF Size(B) > Size(A) THEN
            Swap(A,B);
         END IF;
         IF Size(C) > Size(A) THEN
            Swap(A,C);
         END IF;

         -- rebuild tree
         T1.Left := A;
         T1.Right := Merge(B,C);
         RETURN T1;
      END IF;
   END Merge;

   PROCEDURE Insert(Value : Integer; Heap : IN OUT Heap_Type) IS
      New_Tree : Tree_Ptr;
   BEGIN
      New_Tree := NEW Tree_Node'(Value, 1, NULL, NULL);
      Heap.Root := Merge(Heap.Root, New_Tree);
   END Insert;

   PROCEDURE Merge(Heap1, Heap2 : IN OUT Heap_Type) IS
   BEGIN
      IF Heap1.Root /= Heap2.Root THEN
         -- merge Heap2 into Heap1
         Heap1.Root := Merge(Heap1.Root, Heap2.Root);
         Heap2.Root := NULL;
      END IF;
   END Merge;

   FUNCTION Find_Min(Heap : Heap_Type) RETURN Integer IS
   BEGIN
      IF Heap.Root = NULL THEN
         RAISE Empty_Exception;
      ELSE
         RETURN Heap.Root.Value;
      END IF;
   END Find_Min;

   PROCEDURE Delete_Min(Heap : IN OUT Heap_Type) IS
      Tmp : Tree_Ptr;
   BEGIN
      IF Heap.Root = NULL THEN
         RAISE Empty_Exception;
      ELSE
         Tmp := Heap.Root;
         Heap.Root := Merge(Heap.Root.Left, Heap.Root.Right);
         Deallocate(Tmp);
      END IF;
   END Delete_Min;

   FUNCTION Size(Heap : Heap_Type) RETURN Natural IS
   BEGIN
      IF Heap.Root = NULL THEN
         RETURN 0;
      ELSE
         RETURN Heap.Root.Size;
      END IF;
   END Size;

END Maxiphobic;