Generic, Circularly Linked List using Ada (with example client)

linkedlist.adb

with 
	Ada.Text_IO,
	Ada.Strings,
	linkedlist;
use
	Ada.Text_IO,
	Ada.Strings;
------------------------------------------------------------------------
-- Author	 - James Earle, Std. #5017843
-- Email 	 - je11zi@brocku.ca
-- Course 	 - COSC 2P91 - Procedural Programming
-- Project	 - ADT's
-- Date		 - February 14th, 2014
------------------------------------------------------------------------
package body linkedlist is 
	--have every function and procedure throw the EXCEPTION if curr null
	function toArray ( Curr : NODE_PTR; Count : Integer ) return T_Array is
		A : T_Array( 1..Count );
		Temp : NODE_PTR;
	begin
		if Curr /= null then 
			Temp := Curr;
		
			for I in Integer range 1 .. Count loop 
				A(I) := Temp;
				if Temp.Next /= null then
					Temp := Temp.Next;
				end if;
			
			end loop;
			
			Temp := Curr;
			Connect(Temp,Count);
			
			return A;
		else
			raise LIST_EXCEPTION;
		end if;
		
		exception
			when LIST_EXCEPTION =>
				Put_Line("LIST_EXCEPTION: Cannot operate on null values");
				raise LIST_EXCEPTION;
	end toArray;
	
	procedure Connect ( Curr : out NODE_PTR; C : Integer ) is 
		Temp, F, L : NODE_PTR;
	begin
		
		if Curr /= null then 
			if C > 2 then 
				F := Curr;
				while F.Prev /= null loop
					F := F.Prev;
					if F = Curr then exit; 
					end if;
				end loop;
				
				L := Curr;
				while L.Next /= null loop
					L := L.Next;
					if L = Curr then exit;
					end if;
				end loop;
				
				if F /= Curr and L /= Curr then
					F.Prev := L;
					L.Next := F;
				end if;
			else
				case C is
					when 0 =>
						raise LIST_EXCEPTION;
					when 1 =>
						Curr.Next := Curr;
						Curr.Prev := Curr;
					when 2 =>
						if Curr.Next /= null then
							Temp := Curr.Next;
							Temp.Next := Curr;
							Curr.Prev := Temp;
						else
							Temp := Curr.Prev;
							Temp.Prev := Curr;
							Curr.Next := Temp;
						end if;
					when others =>
						raise LIST_EXCEPTION;
				end case;
			end if;
		else
			raise LIST_EXCEPTION;
		end if;
		
		exception 
			when LIST_EXCEPTION =>
				Put_Line("LIST_EXCEPTION: Count value must be nonnegative.");
				raise LIST_EXCEPTION;
	end Connect;
	
	-- Insert 'N' before 'Curr'
	procedure Insert_Before ( T : Element_T; Curr : out NODE_PTR; I : in out Integer ) is
		Temp : NODE_PTR;
		N : NODE_PTR := new NODE;
	begin
		
		if Curr /= null then
		
			if Curr.Prev = null then 
			
				N.Data := T;
				N.Next := Curr;
				N.Prev := null;
		
				Curr.Prev := N;
				
				I := I + 1;
				
				if I < 4 then 
					Connect(Curr,I);
				end if;
			else
			
				Temp := Curr.Prev;
			
				N.Prev := Temp;
				N.Next := Curr;
				N.Data := T;
			
				Curr.Prev := N;
				Temp.Next := N;
				
				I := I + 1;
				
				if I < 4 then 
					Connect(Curr,I);
				end if;
				
			end if;
		else 
			raise LIST_EXCEPTION;
		end if;
		
		exception
			when LIST_EXCEPTION =>
				Put_Line("LIST_EXCEPTION: Cannot operate on NULL values");
				raise LIST_EXCEPTION;
	end Insert_Before;
	
	-- Insert 'N' after 'Curr'
	procedure Insert_After  ( T : Element_T; Curr : out NODE_PTR; I : in out Integer ) is
		Temp : NODE_PTR;
		N : NODE_PTR := new NODE;
	begin
		
		if Curr /= null then 
			
			if Curr.Next = null then
			
				N.Data := T;
				N.Next := null;
				N.Prev := Curr;
				
				I := I + 1;
				
				if I < 4 then 
					Connect(Curr,I);
				end if;
				
			else
				
				Temp := Curr.Next;
				
				N.Next := Temp;
				N.Prev := Curr;
				N.Data := T;
				
				Temp.Prev := N;
				Curr.Next := N;
				
				I := I + 1;
				
				if I < 4 then 
					Connect(Curr,I);
				end if;
				
			end if;
		
		else
			raise LIST_EXCEPTION;
		end if;
		
		exception
			when LIST_EXCEPTION =>
				Put_Line("LIST_EXCEPTION: Cannot operate on NULL values");
				raise LIST_EXCEPTION;
	end Insert_After;
	
	-- Deletion pushes N.Prev to be current
	procedure Delete_Node ( N : out NODE_PTR; I : in out Integer ) is
		T1,T2 : NODE_PTR;
	begin
		
		if N /= null then
			T1 := N.Prev;
			T2 := N.Next;
		
			T2.Prev := T1;
			T1.Next := T2;
		
			I := I - 1;
			
			if I < 4 then 
				Connect(T1,I);
			end if;
			Free(N);
		else
			Free(N);
			raise LIST_EXCEPTION;
		end if;
		
		exception
			when LIST_EXCEPTION =>
				Put_Line("LIST_EXCEPTION: Deletion of null value invalid. Variable freed");
				raise LIST_EXCEPTION;
	end Delete_Node;
	
	procedure Rotate_CW  ( N : out NODE_PTR ) is 
	
	begin
		if N /= null and then N.Next /= null then
			N := N.Next;
		else 
			raise LIST_EXCEPTION;
		end if;
		
		exception 
			when LIST_EXCEPTION =>
				Put_Line("LIST_EXCEPTION: Cannot rotate to null address");
				raise LIST_EXCEPTION;
	end Rotate_CW;  -- Clockwise
	
	procedure Rotate_CCW ( N : out NODE_PTR ) is 

	begin 
		if N /= null and then N.Prev /= null then 
			N := N.Prev;
		else 
			raise LIST_EXCEPTION;
		end if;
		
		exception
			when LIST_EXCEPTION =>
				Put_Line("LIST_EXCEPTION: Cannot rotate to null address");
				raise LIST_EXCEPTION;
	end Rotate_CCW; -- Counter Clockwise
	
end linkedlist;

linkedlist.ads

with Unchecked_Deallocation;
------------------------------------------------------------------------
-- Author	 - James Earle, Std. #5017843
-- Email 	 - je11zi@brocku.ca
-- Course 	 - COSC 2P91 - Procedural Programming
-- Project	 - ADT's
-- Date		 - February 14th, 2014
------------------------------------------------------------------------
generic
	type Element_T is private;

package linkedlist is 

	type linkedlist is private;
	LIST_EXCEPTION : exception;
	
	type NODE;
	type NODE_PTR is access all NODE;
	type T_Array is array ( Positive range <> ) of NODE_PTR;
	
	type NODE is record
		Next : NODE_PTR;
		Prev : NODE_PTR;
		Data : Element_T;
	end record;
	
	function toArray ( Curr : NODE_PTR; Count : Integer ) return T_Array;
	
	procedure Connect ( Curr : out NODE_PTR; C : Integer );
	procedure Insert_Before ( T : Element_T; Curr : out NODE_PTR; I : in out Integer );
	procedure Insert_After  ( T : Element_T; Curr : out NODE_PTR; I : in out Integer );
	
	procedure Delete_Node ( N : out NODE_PTR; I : in out Integer );
	procedure Rotate_CW  ( N : out NODE_PTR );  -- Clockwise
	procedure Rotate_CCW ( N : out NODE_PTR ); -- Counter Clockwise
	procedure Free is new Unchecked_Deallocation( NODE, NODE_PTR );
	
private	
	type linkedlist is record
		Current : NODE;
		Counter : Integer;
	end record;
end linkedlist;

ll_client.adb

with
	Ada.Text_IO,
	Ada.Strings,
	Ada.Strings.Fixed,
	linkedlist;
use
	Ada.Text_IO,
	Ada.Strings,
	Ada.Strings.Fixed;
------------------------------------------------------------------------
-- Author	 - James Earle, Std. #5017843
-- Email 	 - je11zi@brocku.ca
-- Course 	 - COSC 2P91 - Procedural Programming
-- Project	 - ADT's
-- Date		 - February 14th, 2014
------------------------------------------------------------------------
procedure ll_client is 
	
	package LL is new linkedlist( Element_T => Integer );
	use LL;
	
	Init_Node : LL.NODE := ( null, null, 1 );
	
	Curr : LL.NODE_PTR;
	Temp : NODE_PTR := new NODE;
	C : Integer := 1;
	
	type List_Array is array ( Positive range <> ) of NODE_PTR;
	A : List_Array(1..50);
	F : T_Array(1..200); 
	-- Default size, to allow for lists up to 200 in length.
	-- When using toArray, must restrain size to be F(1..C) 
	-- as shown below.
begin
	
	Curr := new NODE;
	Curr.Next := null;
	Curr.Prev := null;
	Curr.Data := 1;
		
	-- Demonstration of various procedures, functions, and
	-- scenarios below. Including the 3 initial cases of list 
	-- creation and deletion (1 node, 2 nodes, or >3 nodes).	
	
------------------------------------------------------------------------

	Put_Line("---------- Insertion Test ----------");
	Put_Line("Count:" & Integer'Image(C));
	Connect(Curr,C);
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	
	Insert_After(2,Curr,C);
	Put_Line("Count:" & Integer'Image(C));
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	
	Insert_Before(3,Curr,C);
	Put_Line("Count:" & Integer'Image(C));
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
			
	-- Now we will display the Rotations, both counter clockwise
	-- and clockwise, and view how the output changes order based
	-- off of the location of our initial "Curr" value.
	New_Line(1);
	Put_Line("---------- Rotation Testing ----------");
	Put_Line("CW");
	Put("Before:");
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	Rotate_CW(Curr);
	Put("After:");
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	
	Put_Line("CW");
	Put("Before:");
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	Rotate_CW(Curr);
	Put("After:");
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	
	Put_Line("CCW");
	Put("Before:");
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	Rotate_CCW(Curr);
	Put("After:");
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	
	Put_Line("CCW");
	Put("Before:");
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	Rotate_CCW(Curr);
	Put("After:");
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	
	-- Testing removal of nodes and how it affects our output. Note 
	-- that the Current node's previous and next values are linked,
	-- and a duplicate result is output. Because deletion Frees the
	-- given variable, it is required to store the Curr.Prev prior 
	-- to the procedure call. If so desired, the Curr variable can
	-- be reassigned to maintain continuity, however the node that 
	-- was deleted during the operation is still gone.
	New_Line(1);
	Put_Line("---------- Deletion Testing ----------");
	Put_Line("Count: " & Integer'Image(C));
	Put("Before:");
	Put_Line(Integer'Image(Curr.Data) & Integer'Image(Curr.Next.Data) 
			& Integer'Image(Curr.Prev.Data));
	Temp := Curr.Prev;
	Delete_Node(Curr,C);
	Put_Line("Count: " & Integer'Image(C));
	Put("After:");
	Put_Line(Integer'Image(Temp.Data) & Integer'Image(Temp.Next.Data) 
			& Integer'Image(Temp.Prev.Data));
	
	-- Testing the looping to show that all of the nodes form a 
	-- circular doubly linked list.
	New_Line(1);
	Put_Line("---------- Loop Testing ----------");
	Insert_After(1,Temp.Next,C);
	Insert_Before(4,Temp,C);
	
	Temp := Temp.Prev;
	Curr := Temp;
	
	Put_Line("Moving Forward");
	
	for I in Integer range 1 .. 12 loop
	
		Put_Line(Integer'Image(Curr.Data));
		Curr := Curr.Next;
	
	end loop;
	
	Curr := Curr.Prev;
	
	New_Line(1);
	Put_Line("Moving Backward");
	
	for I in Integer range 1 .. 12 loop
	
		Put_Line(Integer'Image(Curr.Data));
		Curr := Curr.Prev;
		
	end loop;
	
	Curr := Curr.Next;
	New_Line(1);
	Put_Line("---------- Array Testing ----------");
	
	F(1..C) := toArray(Curr,C);
	for I in Integer range 1..C loop
	
		Put_Line("A[" & Integer'Image(I) & " ] = " 
				& Integer'Image(F(I).Data));
	
	end loop;
	
	New_Line(1);
	Curr := Curr.Next.Next;
	Put_Line("---------- Testing Large List ----------");
	for I in Integer range 1..50 loop
		Insert_Before(I,Curr,C);
		Curr := Curr.Prev;
	end loop;
	-- Note that at the end of the output from the array is altered 
	-- because of the previous values we contained in the list 
	F(1..C) := toArray(Curr,C);
	for I in Integer range 1..C loop
		Put(Integer'Image(F(I).Data) & "  --- ");
	end loop;
	
end LL_Client;