--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
--Program_2
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
WITH Ada.Text_IO;
WITH Ada.Integer_Text_IO;
WITH Binary_Tree_String;

USE Ada.Text_IO;
USE Ada.Integer_Text_IO;

PROCEDURE Program_2 IS

TempStr : Binary_Tree_String.ElementType;
TempLen : Natural;
StrTree : Binary_Tree_String.Bi_Tree;
Cur : Binary_Tree_String.NodePtr;

MaxDepth, MinDepth, AvgDepth : Binary_Tree_String.DepthRange := -1;

In_File1, In_File2, Out_File1, Out_File2 : Ada.Text_IO.File_Type;

BEGIN

Ada.Text_IO.Open(File => In_File1,
                 Mode => Ada.Text_IO.In_File,
                 Name => "Input1.txt");

Ada.Text_IO.Open(File => In_File2,
                 Mode => Ada.Text_IO.In_File,
                 Name => "Input2.txt");

Ada.Text_IO.Open(File => Out_File1,
                 Mode => Ada.Text_IO.Out_File,
                 Name => "Output1.txt");

Ada.Text_IO.Open(File => Out_File2,
                 Mode => Ada.Text_IO.Out_File,
                 Name => "Output2.txt");

--Loading the first line of the file as the Root of the tree
Ada.Text_IO.Get_Line(Item => TempStr, Last => TempLen, File => In_File1);
Binary_Tree_String.Initialize(BT => StrTree, X=> TempStr, Length => TempLen);

--Loading input file 1 into the binary tree
WHILE Ada.Text_IO.End_Of_File(In_File1) = False LOOP
Ada.Text_IO.Get_Line(Item => TempStr, Last => TempLen, File => In_File1);
Binary_Tree_String.Add_Organized(BT => StrTree, X => TempStr, Length => TempLen);
END LOOP;

-----------------------------------------------------------
--This Inorder procedure works, and is much more     --
--efficient. I had to use my original one however  --
--because it was integrated with my Max, Min      --
--and Average Depth procedures.                       --
--********************************** --
--Put_Line("Inorder display: ");                            --
--Binary_Tree_String.Display_Inorder(StrTree);    --
--***********************************--
------------------------------------------------------------
--Displaying the binary tree to the screen, as well as calculating the max, min, and average depths
Put_Line("The tree before deletion: ");
Put_Line("     Inorder: ");
Binary_Tree_String.Display(BT => StrTree, MD => MaxDepth, MiD => MinDepth, AD => AvgDepth);
Put_Line("     Preorder: ");
Binary_Tree_String.Display_Preorder(StrTree);

--Writing the max, min, and average depths to output file 1
Put(Item => "The maximum depth is : ", File => Out_File1);
Put(Item => MaxDepth, Width => 4, File => Out_File1);
New_Line(File => Out_File1);
Put(Item => "The minimum depth is : ", File => Out_File1);
Put(Item => MinDepth, Width => 4, File => Out_File1);
New_Line(File => Out_File1);
Put(Item => "The average depth is : ", File => Out_File1);
Put(Item => AvgDepth, Width => 4, File => Out_File1);
New_Line(File => Out_File1);

New_Line;

--Removing everything in input file 1 from the binary tree
WHILE Ada.Text_IO.End_Of_File(In_File2) = False LOOP
Ada.Text_IO.Get_Line(Item => TempStr, Last => TempLen, File => In_File2);
Binary_Tree_String.Delete(BT => StrTree, X => TempStr(1..TempLen));
END LOOP;

--Displaying the binary tree to the screen, as well as calculating the max, min, and average depths
Put_Line("The tree after deletion: ");
Put_Line("     Inorder: ");
Binary_Tree_String.Display(BT => StrTree, MD => MaxDepth, MiD => MinDepth, AD => AvgDepth);
Put_Line("     Preorder: ");
Binary_Tree_String.Display_Preorder(StrTree);

--Writing the max, min, and average depths to output file 2
Put(Item => "The maximum depth is : ", File => Out_File2);
Put(Item => MaxDepth, Width => 4, File => Out_File2);
New_Line(File => Out_File2);
Put(Item => "The minimum depth is : ", File => Out_File2);
Put(Item => MinDepth, Width => 4, File => Out_File2);
New_Line(File => Out_File2);
Put(Item => "The average depth is : ", File => Out_File2);
Put(Item => AvgDepth, Width => 4, File => Out_File2);
New_Line(File => Out_File2);

END Program_2;
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
--Binary_Tree_String.ads
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
WITH stacks_Generic;

PACKAGE Binary_Tree_String IS

   SUBTYPE ElementType IS String(1..32);
      SUBTYPE States IS Integer RANGE 1..3;
      SUBTYPE DepthRange IS Integer Range -1..Integer'Last;
      --TYPE States IS (Left, Right, Both, Neither, Visited);
   TYPE Node;
   TYPE NodePtr IS ACCESS Node;

   TYPE Node IS RECORD
      Info : ElementType;
            Length : Natural;
      Parent, Left, Right : NodePtr;
   END RECORD;

   TYPE Bi_Tree IS RECORD
      Root : NodePtr;
   END RECORD;

      Does_Not_Exist : EXCEPTION;

      PACKAGE Stacks IS NEW stacks_generic(StackElement => States);

      OutOfSpace: EXCEPTION;

   PROCEDURE Initialize(BT : IN OUT Bi_Tree; X : IN ElementType; Length : IN Natural);

   PROCEDURE Add_Organized(BT : IN OUT Bi_Tree; X : ElementType; Length : IN Natural);

   PROCEDURE Display(BT : IN Bi_Tree; MD, MiD, AD : IN OUT DepthRange);

      PROCEDURE Display_Inorder(BT : IN Bi_Tree);

      PROCEDURE Display_Preorder(BT : IN Bi_Tree);

      PROCEDURE Depth_Max_Min_Average(Max, Min, Average : IN OUT DepthRange; CurDepth : IN DepthRange);

    FUNCTION Search(BT : IN Bi_Tree; X : IN String) RETURN NodePtr;

   PROCEDURE Delete(BT : IN OUT Bi_Tree; X : IN String);

   FUNCTION Find_Max(Cur : IN NodePtr) RETURN NodePtr;

END Binary_Tree_String;
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
--Binary_Tree_String.adb
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
WITH Unchecked_Deallocation;
WITH Ada.Text_IO;
WITH Ada.Integer_Text_IO;
USE Ada.Text_IO;
USE Ada.Integer_Text_IO;

PACKAGE BODY Binary_Tree_String IS

   PROCEDURE Dispose IS NEW Unchecked_Deallocation(Object => Node, Name => NodePtr);
      ----------------------------------------------------------------------------
   FUNCTION Allocate(X : ElementType; Length : Natural; Parent, Left, Right : NodePtr) RETURN NodePtr IS
      Result : NodePtr;
   BEGIN
            BEGIN
            Result := NEW Node'(Info => X, Length => Length, Parent => Parent, Left => Left, Right => Right);
            RETURN Result;
          EXCEPTION
              WHEN Storage_Error =>
                  RAISE OutOfSpace;
            END;
   END Allocate;
      ----------------------------------------------------------------------------
   PROCEDURE Deallocate(Ptr : IN OUT NodePtr) IS
   BEGIN
      Dispose(X => Ptr);
   END Deallocate;
      ----------------------------------------------------------------------------
   PROCEDURE Initialize(BT : IN OUT Bi_Tree; X : IN ElementType; Length : Natural) IS
   BEGIN
            BT.Root := Allocate(X => X, Length => Length, Parent => NULL, Left => NULL, Right => NULL);
   END Initialize;

   ----------------------------------------------------------------------------
   ----------------------------------------------------------------------------
   ----------------------------------------------------------------------------
   ----------------------------------------------------------------------------
   --Function that determines whether or not the new node goes
   --to the left or to the right.
   FUNCTION Add_Org_Helper(A, B : String) RETURN Boolean IS
      Left_Flag : Boolean;
      I : Positive := 1;
      BEGIN
      LOOP
                  IF I > A'Last THEN
                        RETURN True;
                  ELSIF I > B'Last THEN
                        RETURN False;
                  END IF;

         IF Character'Pos(A(I)) < Character'Pos(B(I)) THEN
            Left_Flag := True;
            Exit;
         ELSIF Character'Pos(A(I)) > Character'Pos(B(I)) THEN
            Left_Flag := False;
            Exit;
         END IF;
         I := I + 1;
      END LOOP;
      RETURN Left_Flag;
      END Add_Org_Helper;
   ----------------------------------------------------------------------------
     ----------------------------------------------------------------------------
      PROCEDURE Add_Org_Recurrer(Cur, Prev : NodePtr; X : IN ElementType; Left_F : IN Boolean; Length : IN Natural) IS
         Current : NodePtr := Cur;
         Previous : NodePtr := Prev;
         Left_Flag : Boolean := Left_F;
      BEGIN
         IF Current = NULL THEN
               Current := Allocate(X => X, Parent => Previous, Left => NULL, Right => NULL, Length => Length);
               IF Previous /= NULL THEN
                  IF Left_Flag = True THEN
                     Previous.Left := Current;
                  ELSE
                     Previous.Right := Current;
                  END IF;
               END IF;
               RETURN;
         END IF;
         Left_Flag := Add_Org_Helper(A => X, B => Current.Info);
         IF X(1..Length) = Current.Info(1..Current.Length) THEN
               RETURN;
         END IF;

         IF Left_Flag = TRUE THEN
            Add_Org_Recurrer(Cur => Current.Left, Prev => Current, X => X, Left_F => Left_Flag, Length => Length);
         ELSE
            Add_Org_Recurrer(Cur => Current.Right, Prev => Current, X => X, Left_F => Left_Flag, Length => Length);
         END IF;
      END Add_Org_Recurrer;
     ----------------------------------------------------------------------------
   ----------------------------------------------------------------------------
   --Procedure that adds a string to the tree in a Binary-Tree-Friendly way
      PROCEDURE Add_Organized(BT : IN OUT Bi_Tree; X : ElementType; Length : IN Natural) IS
      BEGIN
         Add_Org_Recurrer(Cur => BT.Root, Prev => NULL, X => X, Left_F => True, Length => Length);
      END Add_Organized;
      ----------------------------------------------------------------------------
      ----------------------------------------------------------------------------
            ----------------------------------------------------------------------------
            FUNCTION Max_Num(A, B : IN DepthRange) RETURN DepthRange IS
            BEGIN
               IF A > B THEN
                  RETURN A;
               ELSE
                  RETURN B;
               END IF;
            END Max_Num;
            ----------------------------------------------------------------------------
            FUNCTION Min_Num(A, B : IN DepthRange) RETURN DepthRange IS
            BEGIN
               IF A < B THEN
                  RETURN A;
               ELSE
                  RETURN B;
               END IF;
            END Min_Num;
            ----------------------------------------------------------------------------
            FUNCTION Average_Num(A, B : IN DepthRange) RETURN DepthRange IS
               Avg : DepthRange;
            BEGIN
               Avg := (A + B) / 2;
               RETURN Avg;
            END Average_Num;
            ----------------------------------------------------------------------------
                        ----------------------------------------------------------------------------
            PROCEDURE Depth_Max_Min_Average(Max, Min, Average : IN OUT DepthRange; CurDepth : IN DepthRange) IS
            BEGIN
               Max := Max_Num(Max, CurDepth);
               Min := Min_Num(Min, CurDepth);
               Average := Average_Num(Average, CurDepth);
            END Depth_Max_Min_Average;
            ----------------------------------------------------------------------------
                        ----------------------------------------------------------------------------
                        ----------------------------------------------------------------------------
            FUNCTION Find_Max(Cur : IN NodePtr) RETURN NodePtr IS   --Refers to maxinum element in tree
                  Current : NodePtr := Cur;
            BEGIN
                  IF Current.Right /= NULL THEN
                        RETURN Find_Max(Cur => Current.Right);
                  ELSE
                        RETURN Current;
                  END IF;
            END Find_Max;
      ----------------------------------------------------------------------------
      PROCEDURE Display_Helper(Cur : NodePtr; Add_Flag : IN Boolean; TS: IN OUT Stacks.Stack; Max : IN NodePtr; MaxD, MinD, AvgD : IN OUT DepthRange) IS--; TS, VS : IN OUT Stacks.Stack) IS
         Current : NodePtr := Cur;
                  TempPop : States;
                  TempDepth : Natural;
      BEGIN
                  IF Add_Flag = True THEN
                     Stacks.Pop(S => TS, V => TempPop);
                     Stacks.Push(S => TS, E => (TempPop + 1));
                  ELSE
                     Stacks.Push(S => TS, E => 1);
                  END IF;
                  IF Stacks.Top(S => TS) >= 3 THEN
                     IF Current.Parent = NULL THEN
                        RETURN;
                     END IF;
                     Stacks.Pop(S => TS, V=> TempPop);
                     Display_Helper(Cur => Current.Parent , Add_Flag => True, TS => TS, Max => Max, MaxD => MaxD, MinD => MinD, AvgD => AvgD);
                     RETURN;--
                  END IF;

                  IF Current.Left /= NULL THEN
                     IF Stacks.Top(S => TS) = 2 THEN
                           Put_Line(Current.Info(1..Current.Length));-------------------------------
                           IF Current.Info(1..Current.Length) = Max.Info(1..Max.Length) THEN
                              RETURN;
                           END IF;
                           IF Current.Right /= NULL THEN
                                 Display_Helper(Cur => Current.Right, Add_Flag => False, TS => TS, Max => Max, MaxD => MaxD, MinD => MinD, AvgD => AvgD);
                                 RETURN;--
                           ELSE
                                 Stacks.Pop(S => TS, V=> TempPop);
                                 Display_Helper(Cur => Current.Parent, Add_Flag => True, TS => TS, Max => Max, MaxD => MaxD, MinD => MinD, AvgD => AvgD);
                                 RETURN;--
                           END IF;
                     ELSIF Stacks.Top(S => TS) = 3 THEN
                           Stacks.Pop(S => TS, V=> TempPop);
                           Display_Helper(Cur => Current.Parent , Add_Flag => True, TS => TS, Max => Max, MaxD => MaxD, MinD => MinD, AvgD => AvgD);
                           RETURN;--
                     ELSE
                           Display_Helper(Cur => Current.Left, Add_Flag => False, TS => TS, Max => Max, MaxD => MaxD, MinD => MinD, AvgD => AvgD);
                           RETURN;--
                     END IF;
                  ELSIF Current.Right /= NULL THEN
                        IF Stacks.Top(S => TS) = 1 THEN
                              Put_Line(Current.Info(1..Current.Length));
                              Display_Helper(Cur => Current.Right, Add_Flag => False, TS => TS, Max => Max, MaxD => MaxD, MinD => MinD, AvgD => AvgD);
                              RETURN;--
                        ELSIF Stacks.Top(S => TS) = 2 THEN
                              Stacks.Pop(S => TS, V => TempPop);
                              Display_Helper(Cur => Current.Parent, Add_Flag => True, TS => TS, Max => Max, MaxD => MaxD, MinD => MinD, AvgD => AvgD);
                              RETURN;--
                        END IF;
                  ELSE
                        Put_Line(Current.Info(1..Current.Length));---------------------------------
                        TempDepth := Stacks.Count_Stack(S => TS);
                        IF MaxD = -1 AND MinD = -1 AND AvgD = -1 THEN
                           MaxD := TempDepth;
                           MinD := TempDepth;
                           AvgD := TempDepth;
                        ELSE
                           Depth_Max_Min_Average(Max => MaxD, Min => MinD, Average => AvgD, CurDepth => TempDepth);
                        END IF;
                        IF Current.Info(1..Current.Length) = Max.Info(1..Max.Length) THEN
                              RETURN;
                        END IF;
                        Stacks.Pop(S => TS, V => TempPop);
                        Display_Helper(Cur => Current.Parent, Add_Flag => True, TS => TS, Max => Max, MaxD => MaxD, MinD => MinD, AvgD => AvgD);
                        RETURN;--
                  END IF;
      END Display_Helper;
      ----------------------------------------------------------------------------
      PROCEDURE Display(BT : IN Bi_Tree; MD, MiD, AD : IN OUT DepthRange) IS
         TStack : Stacks.Stack;
         Max : NodePtr;
      BEGIN
         Max := Find_Max(BT.Root);
         Stacks.MakeStack(S => TStack);
         Display_Helper(Cur => BT.Root, Add_Flag => False, TS => TStack, Max => Max, MaxD => MD, MinD => MiD, AvgD => AD);--, VS => VStack);
      END Display;
            ----------------------------------------------------------------------------
            ----------------------------------------------------------------------------
            PROCEDURE Display_IO_Helper(Cur : IN NodePtr) IS
                  Current : NodePtr := Cur;
            BEGIN
                  IF Current = NULL THEN
                        RETURN;
                  END IF;
                  Display_IO_Helper(Current.Left);
                  Put_Line(Current.Info(1..Current.Length));
                  Display_IO_Helper(Current.Right);
            END Display_IO_Helper;
            ----------------------------------------------------------------------------
            PROCEDURE Display_Inorder(BT : IN Bi_Tree) IS
            BEGIN
                  Display_IO_Helper(BT.Root);
            END Display_Inorder;
      ----------------------------------------------------------------------------
      ----------------------------------------------------------------------------
            ----------------------------------------------------------------------------
            PROCEDURE Display_PO_Helper(Cur : IN NodePtr) IS
                  Current : NodePtr := Cur;
            BEGIN
                  IF Current = NULL THEN
                        RETURN;
                  END IF;
                  Put_Line(Current.Info(1..Current.Length));
                  Display_PO_Helper(Current.Left);
                  Display_PO_Helper(Current.Right);
            END Display_PO_Helper;
            ----------------------------------------------------------------------------
            PROCEDURE Display_Preorder(BT : IN Bi_Tree) IS
            BEGIN
                  Display_PO_Helper(BT.Root);
            END Display_Preorder;
      ----------------------------------------------------------------------------
            ----------------------------------------------------------------------------
      ----------------------------------------------------------------------------
            FUNCTION Search(BT : IN Bi_Tree; X : IN String) RETURN NodePtr IS
               Current : NodePtr;
               Left_Flag : Boolean;
            BEGIN
                  Current := BT.Root;
                  LOOP
                        IF Current.Info(1..Current.Length) = X THEN
                              RETURN Current;
                        END IF;
                        Left_Flag := Add_Org_Helper(A => X, B => Current.Info(1..Current.Length));
                        IF Left_Flag = True THEN
                           Current := Current.Left;
                        ELSE
                           Current := Current.Right;
                        END IF;
                        IF Current = NULL THEN
                           RAISE Does_Not_Exist;
                        END IF;
                  END LOOP;
                  RETURN NULL;
            END Search;
            ----------------------------------------------------------------------------
                        ----------------------------------------------------------------------------
                        FUNCTION Is_Left_Child(N : NodePtr) RETURN Boolean IS
                        BEGIN
                              IF N.Parent.Left = N THEN
                                    RETURN True;
                              ELSE
                                    RETURN False;
                              END IF;
                        END Is_Left_Child;
                        ----------------------------------------------------------------------------
            PROCEDURE Delete(BT : IN OUT Bi_Tree; X : IN String) IS
                              NtD : NodePtr;
                              TempNode : NodePtr;
                   BEGIN
                              NtD := Search(BT => BT, X => X);
                              IF BT.Root = NtD THEN
                                    TempNode := Find_Max(NtD.Left);
                                    NtD.Left.Parent := NULL;
                                    BT.Root := NtD.Left;
                                    TempNode.Right := NtD.Right;
                                    NtD.Right.Parent := TempNode;
                              ELSIF NtD.Right /= NULL AND Ntd.Left /= NULL THEN
                                    TempNode := Find_Max(NtD.Left);
                                    NtD.Left.Parent := NtD.Parent;
                                    IF Is_Left_Child(NtD) = TRUE THEN
                                          NtD.Parent.Left := NtD.Left;
                                    ELSE
                                          Ntd.Parent.Right := Ntd.Left;
                                    END IF;
                                    TempNode.Right := NtD.Right;
                                    NtD.Right.Parent := TempNode;
                              ELSIF NtD.Right = NULL AND NtD.Left /= NULL THEN   --Node to be removed has one left child
                                    Ntd.Left.Parent := NtD.Parent;
                                    IF Is_Left_Child(NtD) = TRUE THEN
                                          NtD.Parent.Left := NtD.Left;
                                    ELSE
                                          Ntd.Parent.Right := Ntd.Left;
                                    END IF;
                              ELSIF NtD.Right /= NULL AND NtD.Left = NULL THEN   --Node to be removed has one right child
                                    Ntd.Right.Parent := Ntd.Parent;
                                    IF Is_Left_Child(NtD) = TRUE THEN
                                          NtD.Parent.Left := NtD.Right;
                                    ELSE
                                          Ntd.Parent.Right := Ntd.Right;
                                    END IF;
                              ELSE                                                                     --Node to be removed has no children
                                    IF Is_Left_Child(NtD) = TRUE THEN
                                          Ntd.Parent.Left := NULL;
                                    ELSE
                                          Ntd.Parent.Right := NULL;
                                    END IF;
                              END IF;
                              Deallocate(Ptr => NtD);
            END Delete;
            ----------------------------------------------------------------------------
END Binary_Tree_String;
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
--stacks_Generic.ads
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
WITH lists_generic;
GENERIC
TYPE StackElement IS PRIVATE;
PACKAGE stacks_generic IS

TYPE Stack IS LIMITED PRIVATE;

StackEmpty : Exception;

PROCEDURE MakeStack ( S : IN OUT Stack);

PROCEDURE EmptyStack (S : IN OUT Stack);

PROCEDURE Push (S : IN OUT Stack; E : IN StackElement);

PROCEDURE Pop (S : IN OUT Stack; V : OUT StackElement);

FUNCTION Count_Stack(S : IN Stack) RETURN Natural;

FUNCTION Top (S : IN Stack) RETURN StackElement;

FUNCTION IsEmpty (S : IN Stack) RETURN Boolean;

PRIVATE

PACKAGE Lists IS NEW lists_generic(ElementType => StackElement);

TYPE Stack IS RECORD
Store : Lists.List;
END RECORD;

END stacks_generic;
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
--stacks_Generic.adb
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
PACKAGE BODY Stacks_Generic IS

  PROCEDURE MakeStack (S : IN OUT Stack) IS
  BEGIN
     Lists.Initialize(S.Store);
  END MakeStack;

  PROCEDURE EmptyStack (S : IN OUT Stack) IS
  BEGIN
    Lists.MakeEmpty(S.Store);
  END EmptyStack;

  FUNCTION IsEmpty (S : IN Stack) RETURN Boolean IS
  BEGIN
    RETURN Lists.IsEmpty(S.Store);
  END IsEmpty;

  PROCEDURE Push (S : IN OUT Stack; E : IN StackElement) IS
  BEGIN
     Lists.AddToFront(S.Store, E);
  END Push;

  FUNCTION Top (S : IN Stack) RETURN StackElement IS
     Ptr : Lists.Position;
     Elem : StackElement;
  BEGIN
     Ptr := Lists.First(S.Store);
     Elem := Lists.Retrieve(S.Store, Ptr);
     RETURN Elem;
  END Top;

  PROCEDURE Pop (S : IN OUT Stack; V : OUT StackElement) IS
  BEGIN
     V := Top(S);
     Lists.RemoveFront(S.Store);
  END Pop;

    FUNCTION Count_Stack(S : IN Stack) RETURN Natural IS
       Count : Natural;
    BEGIN
       Count := Lists.Count_List(S.Store);
       RETURN Count;
    END Count_Stack;

END Stacks_Generic;
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
--lists_Generic.ads
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
GENERIC

   TYPE ElementType IS PRIVATE;
   --WITH PROCEDURE DisplayElement(Item : IN ElementType);
PACKAGE lists_generic IS

  TYPE Position IS PRIVATE;
  TYPE List IS LIMITED PRIVATE;


  OutOfSpace: EXCEPTION;
  PastEnd   : EXCEPTION;
  PastBegin : EXCEPTION;
  EmptyList : EXCEPTION;



  PROCEDURE Initialize(L: IN OUT List);

  PROCEDURE AddToFront(L: IN OUT List; X: ElementType);

  PROCEDURE RemoveFront(L : IN OUT List);

  PROCEDURE MakeEmpty(L : IN OUT List);

  FUNCTION First (L: List) RETURN Position;

  FUNCTION Retrieve (L: IN List; P: IN Position) RETURN ElementType;

    FUNCTION Count_List ( L : IN List) RETURN Natural;

  FUNCTION  IsFirst   (L: List; P: Position) RETURN Boolean;
  FUNCTION  IsLast    (L: List; P: Position) RETURN Boolean;
  FUNCTION IsEmpty (L: List) RETURN Boolean;


PRIVATE

  TYPE Node;
  TYPE Position IS ACCESS Node;

  TYPE Node IS RECORD
    Info: ElementType;
    Link: Position;
  END RECORD;

  TYPE List IS RECORD
    Head: Position;
    Tail: Position;
  END RECORD;

END Lists_Generic;
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
--lists_Generic.adb
--------------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------
WITH Unchecked_Deallocation;
PACKAGE BODY Lists_Generic IS

  PROCEDURE Dispose IS
    NEW Unchecked_Deallocation(Object => Node, Name => Position);

  FUNCTION Allocate (X: ElementType; P: Position) RETURN Position IS
    Result: Position;
  BEGIN
    Result := NEW Node'(Info => X, Link => P);
    RETURN Result;
  EXCEPTION
    WHEN Storage_Error =>
      RAISE OutOfSpace;
  END Allocate;

  PROCEDURE Deallocate (P: IN OUT Position) IS
  BEGIN
    Dispose (X => P);
  END Deallocate;

  PROCEDURE Initialize(L: IN OUT List) IS
    Previous: Position;
    Current : Position;
  BEGIN
    IF L.Head /= NULL THEN
      Current := L.Head;
      WHILE Current /= NULL LOOP
    Previous := Current;
    Current := Current.Link;
    Deallocate(Previous);
      END LOOP;
      L := (Head => NULL, Tail => NULL);
    END IF;
  END Initialize;
---------------------------------------------------------
  PROCEDURE AddToFront(L: IN OUT List; X: ElementType) IS
  BEGIN
    L.Head := Allocate(X, L.Head);
    IF L.Tail = NULL THEN
      L.Tail := L.Head;
    END IF;
  END AddToFront;
---------------------------------------------------------
  PROCEDURE RemoveFront(L : IN OUT List) IS
     Temp : Position;
  BEGIN
     IF IsEmpty(L) = false THEN
     Temp := L.Head;
     L.Head := L.Head.all.Link;
     Deallocate(Temp);
     END IF;
  END RemoveFront;
---------------------------------------------------------
  PROCEDURE MakeEmpty(L : IN OUT List) IS
     Current : Position := L.Head;
     Next : Position;
  BEGIN
     WHILE Current /= NULL LOOP
        Next := Current.all.Link;
        Deallocate(Current);
        Current := Next;
     END LOOP;
     L := (Head => NULL, Tail => NULL);
  END MakeEmpty;
---------------------------------------------------------
  FUNCTION First (L: List) RETURN Position IS
  BEGIN
    RETURN L.Head;
  END First;
---------------------------------------------------------
  FUNCTION Retrieve (L: IN List; P: IN Position) RETURN ElementType IS
  BEGIN
     RETURN P.all.Info;
  END Retrieve;
---------------------------------------------------------
  FUNCTION IsEmpty (L: List) RETURN Boolean IS
  BEGIN
    RETURN L.Head = NULL;
  END IsEmpty;
---------------------------------------------------------
  FUNCTION IsFirst (L: List; P: Position) RETURN Boolean IS
  BEGIN
    RETURN (L.Head /= NULL) AND (P = L.Head);
  END IsFirst;
---------------------------------------------------------
  FUNCTION IsLast (L: List; P: Position) RETURN Boolean IS
  BEGIN
    RETURN (L.Tail /= NULL) AND (P = L.Tail);
  END IsLast;
---------------------------------------------------------
    FUNCTION Count_List ( L : IN List) RETURN Natural IS
         Current : Position := L.Head;
         Count : Natural := 0;
    BEGIN
          LOOP
             IF IsLast(L, Current) = TRUE THEN
                EXIT;
             END IF;
             Current := Current.Link;
             Count := Count + 1;
          END LOOP;
          RETURN Count;
    END Count_List;
---------------------------------------------------------
END Lists_Generic;