162 lines
4.4 KiB
Ada
162 lines
4.4 KiB
Ada
with Ada.Text_IO, Bin_Trees.Traverse;
|
|
|
|
procedure Main is
|
|
|
|
package B_Trees is new Bin_Trees(Character); use B_Trees;
|
|
|
|
function Same_Fringe(T1, T2: Tree_Type) return Boolean is
|
|
|
|
protected type Buffer_Type is
|
|
entry Write(Item: Character);
|
|
entry Write_Done;
|
|
entry Read_And_Compare(Item: Character);
|
|
entry Read_Done;
|
|
entry Wait_For_The_End;
|
|
function Early_Abort return Boolean;
|
|
function The_Same return Boolean;
|
|
private
|
|
Current: Character;
|
|
Readable: Boolean := False;
|
|
Done: Boolean := False;
|
|
Same: Boolean := True;
|
|
Finished: Boolean := False;
|
|
end Buffer_Type;
|
|
|
|
protected body Buffer_Type is
|
|
|
|
entry Write(Item: Character) when not Readable is
|
|
begin
|
|
Readable := True;
|
|
Current := Item;
|
|
end Write;
|
|
|
|
entry Write_Done when not Readable is
|
|
begin
|
|
Readable := True;
|
|
Done := True;
|
|
end Write_Done;
|
|
|
|
entry Read_And_Compare(Item: Character) when Readable is
|
|
begin
|
|
if Done then -- Producer is already out of items
|
|
Same := False;
|
|
Finished := True;
|
|
-- Readable remains True, else Consumer might lock itself out
|
|
elsif
|
|
Item /= Current then
|
|
Same := False;
|
|
Finished := True;
|
|
Readable := False;
|
|
else
|
|
Readable := False;
|
|
end if;
|
|
end Read_And_Compare;
|
|
|
|
entry Read_Done when Readable is
|
|
begin
|
|
Readable := False;
|
|
Same := Same and Done;
|
|
Finished := True;
|
|
end Read_Done;
|
|
|
|
entry Wait_For_The_End when (Finished) or (not Same) is
|
|
begin
|
|
null; -- "when ..." is all we need
|
|
end Wait_For_The_End;
|
|
|
|
function The_Same return Boolean is
|
|
begin
|
|
return Same;
|
|
end The_Same;
|
|
|
|
function Early_Abort return Boolean is
|
|
begin
|
|
return not The_Same or Finished;
|
|
end Early_Abort;
|
|
|
|
end Buffer_Type;
|
|
|
|
Buffer: Buffer_Type;
|
|
|
|
-- some wrapper subprogram needed to instantiate the generics below
|
|
|
|
procedure Prod_Write(Item: Character) is
|
|
begin
|
|
Buffer.Write(Item);
|
|
end Prod_Write;
|
|
|
|
function Stop return Boolean is
|
|
begin
|
|
return Buffer.Early_Abort;
|
|
end Stop;
|
|
|
|
procedure Prod_Stop is
|
|
begin
|
|
Buffer.Write_Done;
|
|
end Prod_Stop;
|
|
|
|
procedure Cons_Write(Item: Character) is
|
|
begin
|
|
Buffer.Read_And_Compare(Item);
|
|
end Cons_Write;
|
|
|
|
procedure Cons_Stop is
|
|
begin
|
|
Buffer.Read_Done;
|
|
end Cons_Stop;
|
|
|
|
package Producer is new B_Trees.Traverse(Prod_Write, Stop, Prod_Stop);
|
|
package Consumer is new B_Trees.Traverse(Cons_Write, Stop, Cons_Stop);
|
|
|
|
begin
|
|
Producer.Inorder_Task.Run(T1);
|
|
Consumer.Inorder_Task.Run(T2);
|
|
Buffer.Wait_For_The_End;
|
|
return Buffer.The_Same;
|
|
end Same_Fringe;
|
|
|
|
procedure Show_Preorder(Tree: Tree_Type; Prefix: String := "") is
|
|
use Ada.Text_IO;
|
|
begin
|
|
if Prefix /= "" then
|
|
Ada.Text_IO.Put(Prefix);
|
|
end if;
|
|
if not Empty(Tree) then
|
|
Put("(" & Item(Tree)); Put(", ");
|
|
Show_Preorder(Left(Tree)); Put(", ");
|
|
Show_Preorder(Right(Tree)); Put(")");
|
|
end if;
|
|
if Prefix /= "" then
|
|
New_Line;
|
|
end if;
|
|
end Show_Preorder;
|
|
|
|
T_0: Tree_Type := Tree('a', Empty, Tree('b'));
|
|
T: array(1 .. 5) of Tree_Type;
|
|
|
|
begin
|
|
T(1) := Tree('d', Tree('c'), T_0);
|
|
T(2) := Tree('c', Empty, Tree('a', Tree('d'), Tree('b')));
|
|
T(3) := Tree('e', T(1), T(2));
|
|
T(4) := Tree('e', T(2), T(1));
|
|
T(5) := Tree('e', T_0, Tree('c', Tree('d'), T(1)));
|
|
|
|
-- First display the trees you have (in preorder)
|
|
for I in T'Range loop
|
|
Show_Preorder(T(I), "Tree(" & Integer'Image(I) & " ) is ");
|
|
end loop;
|
|
Ada.Text_IO.New_Line;
|
|
|
|
-- Now compare them, which have the same fringe?
|
|
for I in T'Range loop
|
|
for J in T'Range loop
|
|
if Same_Fringe(T(J), T(I)) then
|
|
Ada.Text_IO.Put("same(");
|
|
else
|
|
Ada.Text_IO.Put("DIFF(");
|
|
end if;
|
|
Ada.Text_IO.Put(Integer'Image(I) & "," & Integer'Image(J) & " ); ");
|
|
end loop;
|
|
Ada.Text_IO.New_Line;
|
|
end loop;
|
|
end Main;
|