Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,26 +0,0 @@
|
|||
generic
|
||||
type Data is private;
|
||||
package Bin_Trees is
|
||||
|
||||
type Tree_Type is private;
|
||||
|
||||
function Empty(Tree: Tree_Type) return Boolean;
|
||||
function Left (Tree: Tree_Type) return Tree_Type;
|
||||
function Right(Tree: Tree_Type) return Tree_Type;
|
||||
function Item (Tree: Tree_Type) return Data;
|
||||
function Empty return Tree_Type;
|
||||
|
||||
procedure Destroy_Tree(N: in out Tree_Type);
|
||||
function Tree(Value: Data) return Tree_Type;
|
||||
function Tree(Value: Data; Left, Right : Tree_Type) return Tree_Type;
|
||||
|
||||
private
|
||||
|
||||
type Node;
|
||||
type Tree_Type is access Node;
|
||||
type Node is record
|
||||
Left, Right: Tree_Type := null;
|
||||
Item: Data;
|
||||
end record;
|
||||
|
||||
end Bin_Trees;
|
||||
|
|
@ -1,52 +0,0 @@
|
|||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
package body Bin_Trees is
|
||||
|
||||
function Empty(Tree: Tree_Type) return Boolean is
|
||||
begin
|
||||
return Tree = null;
|
||||
end Empty;
|
||||
|
||||
function Empty return Tree_Type is
|
||||
begin
|
||||
return null;
|
||||
end Empty;
|
||||
|
||||
function Left (Tree: Tree_Type) return Tree_Type is
|
||||
begin
|
||||
return Tree.Left;
|
||||
end Left;
|
||||
|
||||
function Right(Tree: Tree_Type) return Tree_Type is
|
||||
begin
|
||||
return Tree.Right;
|
||||
end Right;
|
||||
|
||||
function Item (Tree: Tree_Type) return Data is
|
||||
begin
|
||||
return Tree.Item;
|
||||
end Item;
|
||||
|
||||
procedure Destroy_Tree(N: in out Tree_Type) is
|
||||
procedure free is new Ada.Unchecked_Deallocation(Node, Tree_Type);
|
||||
begin
|
||||
if not Empty(N) then
|
||||
Destroy_Tree(N.Left);
|
||||
Destroy_Tree(N.Right);
|
||||
Free(N);
|
||||
end if;
|
||||
end Destroy_Tree;
|
||||
|
||||
function Tree(Value: Data; Left, Right : Tree_Type) return Tree_Type is
|
||||
Temp : Tree_Type := new Node;
|
||||
begin
|
||||
Temp.all := (Left, Right, Value);
|
||||
return Temp;
|
||||
end Tree;
|
||||
|
||||
function Tree(Value: Data) return Tree_Type is
|
||||
begin
|
||||
return Tree(Value, null, null);
|
||||
end Tree;
|
||||
|
||||
end Bin_Trees;
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
generic
|
||||
with procedure Process_Data(Item: Data);
|
||||
with function Stop return Boolean;
|
||||
with procedure Finish;
|
||||
package Bin_Trees.Traverse is
|
||||
task Inorder_Task is
|
||||
entry Run(Tree: Tree_Type);
|
||||
-- this will call each Item in Tree and, at the very end, it will call Finish
|
||||
-- except when Stop becomes true; in this case, the task terminates
|
||||
end Inorder_Task;
|
||||
end Bin_Trees.Traverse;
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
package body Bin_Trees.Traverse is
|
||||
task body Inorder_Task is
|
||||
procedure Inorder(Tree: Tree_Type) is
|
||||
begin
|
||||
if not Empty(Tree) and not Stop then
|
||||
Inorder(Tree.Left);
|
||||
if not Stop then
|
||||
Process_Data(Item => Tree.Item);
|
||||
end if;
|
||||
if (not Stop) then
|
||||
Inorder(Tree.Right);
|
||||
end if;
|
||||
end if;
|
||||
end Inorder;
|
||||
T: Tree_Type;
|
||||
begin
|
||||
accept Run(Tree: Tree_Type) do
|
||||
T := Tree;
|
||||
end Run;
|
||||
Inorder(T);
|
||||
Finish;
|
||||
end Inorder_Task;
|
||||
end Bin_Trees.Traverse;
|
||||
|
|
@ -1,162 +0,0 @@
|
|||
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;
|
||||
Loading…
Add table
Add a link
Reference in a new issue