From: "daniel gaudry" <Daniel.Gaudry@wanadoo.fr>
Subject: Specification does not compile
Date: Mon, 4 Jun 2001 14:50:24 +0200
Date: 2001-06-04T12:48:44+00:00 [thread overview]
Message-ID: <9fg03c$pmq$2@wanadoo.fr> (raw)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 14004 bytes --]
--
Daniel.GAUDRY Ph.D.
9 Av CALMELS
92270 Bois Colombes
France
+336 64 19 50 09
Daniel.Gaudry@wanadoo.fr
Daniel.GAUDRY Ph.D.
9 Av CALMELS
92270 Bois Colombes
France
+336 64 19 50 09
Daniel.Gaudry@wanadoo.fr
Please find below specification (w.ads) and corresponding files . I do
not see any error left but cannot have it compiled.
Can somebody please let me know what can be wrong.
Regards
D.GAUDRY
with Poly_Bin_Tree;
package W
is
type Tagged_Record_Type is tagged
record
E : Integer;
end record;
type Tagged_Record_Access_Type is access all Tagged_Record_Type'Class;
function Less(Left, Right : in Tagged_Record_Type'class) return
Boolean;
package Tagged_Bin_Tree_Type is new Poly_Bin_Tree("<"
=> Less,
Tagged_Data_Type
=> Tagged_Record_Type,
Tagged_Data_Access_Type => Tagged_Record_Access_Type);
Bin_Tree : Tagged_Bin_Tree_Type.Bin_Tree_Type;
end W;
--| UNIVERSITY TEACHING CLASS 2001 2002
ADVANCED ADA
--|Daniel.Gaudry@wanadoo.fr
--|
--| d.gaudry May , 21 th 2001
--|
--|
--| needed for > availaility
--|
generic
--|
--| TAGGED TYPE DECLARATION
--|
type Tagged_Data_Type is abstract tagged private;
--|
--|acces to tagged
--|
type Tagged_Data_Access_Type is access all Tagged_Data_Type'Class;
--|
--| for search in the tree
--|
with function "<"(Left, Right : in Tagged_Data_Type'class) return Boolean
is <>;
--|
--|
--|
package Poly_Bin_Tree
is
--|
--| action results
--|
type Result_Code_Type is(Success, Not_Found, Already_There, Is_Full);
--|
--| NODE TYPE DECLARATION
--|
type Bin_Tree_Type is limited private;
--|
--| |�����������������������������������|
--| | Insert |
--| |___________________________________|
--|
procedure Insert(In_The_Tree : in out Bin_Tree_Type;
A_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type);
--|
--| |�����������������������������������|
--| | Update |
--| |___________________________________|
--|
procedure Update(The_Tree : in out Bin_Tree_Type;
With_The_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type);
--|
--| |�����������������������������������|
--| | Retrieve |
--| |___________________________________|
--|
procedure Retrieve(In_The_Tree : in out Bin_Tree_Type;
A_Data : in out Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type);
--|
--| |�����������������������������������|
--| | Delete |
--| |___________________________________|
--|
procedure Delete(In_The_Tree : in out Bin_Tree_Type;
A_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type);
--|
--|
--|
private
--|
--|
--|
type Node_Type;
--|
--|
--|
type Bin_Tree_Type is access Node_Type;
--|
--|
--|
type Node_Type is
record
Left : Bin_Tree_Type;
Right : Bin_Tree_Type;
The_Data : Tagged_Data_Access_Type := null;
end record;
end Poly_Bin_Tree;
--| UNIVERSITY TEACHING CLASS 2001 2002
ADVANCED ADA
--|Daniel.Gaudry@wanadoo.fr
--|
--| d.gaudry May , 21 th 2001
package body Poly_Bin_Tree
is
type Search_Result_Type is(Found,
Null_Tree,
Left,
Right);
--|
--| |==================================|
--| | Search |
--| |==================================|
--|
procedure Search(In_The_Tree : in out Bin_Tree_Type;
A_Data : in Tagged_Data_Type'Class;
Result_Tree : out Bin_Tree_Type;
Search_Result : out Search_Result_Type)
is
Current_Subtree : Bin_Tree_Type := In_The_Tree;
Local_Tree : Bin_Tree_Type;
Result : Search_Result_Type;
begin
--|
--|
--|
if In_The_Tree /= null
then
--|
--|
--|
loop
--|
--|
--|
Local_Tree := Current_Subtree;
--|
--|
--|
if Current_Subtree.The_Data.all < A_Data
then
Result := Right;
Current_Subtree := Current_Subtree.Right;
--|
--|
--|
elsif A_Data < Current_Subtree.The_Data.all
then
Result := Left;
Current_Subtree := Current_Subtree.Left;
--|
--|
--|
else
Result := Found;
exit;
end if;
--|
--|
--|
exit when Current_Subtree = null;
end loop;
--|
--|
--|
Result_Tree := Local_Tree;
Search_Result := Result;
else
--|
--|
--|
Search_Result := Null_Tree;
end if;
end Search;
--|
--| |==================================|
--| | Retrieve |
--| |==================================|
--|
procedure Retrieve(In_The_Tree : in out Bin_Tree_Type;
A_Data : in out Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type)
is
Temporary_Tree : Bin_Tree_Type;
Search_Result : Search_Result_Type;
begin
--|
--|
--|
Search(In_The_Tree => In_The_Tree,
A_Data => A_Data,
Result_Tree => Temporary_Tree,
Search_Result => Search_Result);
--|
--|
--|
if Search_Result = Found
then
A_Data := Temporary_Tree.The_Data.all;
Result_Code := Success;
else
--|
--|
--|
Result_Code := Not_Found;
end if;
end Retrieve;
--|
--| |==================================|
--| | Update |
--| |==================================|
--|
procedure Update(The_Tree : in out Bin_Tree_Type;
With_The_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type)
is
Temporary_Tree : Bin_Tree_Type;
Search_Result : Search_Result_Type;
begin
--|
--|
--|
Search(In_The_Tree => The_Tree,
A_Data => With_The_Data,
Result_Tree => Temporary_Tree,
Search_Result => Search_Result);
--|
--|
--|
if Search_Result = Found
then
Temporary_Tree.The_Data.all :=
Tagged_Data_Type'Class'(with_The_Data);
Result_Code := Success;
else
Result_Code := Not_Found;
end if;
end Update;
--|
--| |�����������������������������������|
--| | Insert |
--| |___________________________________|
--|
procedure Insert(In_The_Tree : in out Bin_Tree_Type;
A_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type)
is
Temporary_Tree : Bin_Tree_Type;
Search_Result : Search_Result_Type;
begin
--|
--|
--|
Search(In_The_Tree => In_The_Tree,
A_Data => A_Data,
Result_Tree => Temporary_Tree,
Search_Result => Search_Result);
--|
--|
--|
case Search_Result is
--|
--|
--|
when Found =>
Result_Code := Already_There;
return;
--|
--|
--|
when Null_Tree =>
In_The_Tree := new Node_Type'(left => null,
Right => null,
The_Data => new
Tagged_Data_Type'Class'(a_Data));
--|
--|
--|
when Left =>
Temporary_Tree.Left := new Node_Type'(left => null,
Right => null,
The_Data => new
Tagged_Data_Type'Class'(a_Data));
--|
--|
--|
when Right =>
Temporary_Tree.Right := new Node_Type'(left => null,
Right => null,
The_Data => new
Tagged_Data_Type'Class'(a_Data));
end case;
--|
--|
--|
Result_Code := Success;
--|
--|
--|
exception
when Storage_Error =>
Result_Code := Is_Full;
end Insert;
--|
--| |==================================|
--| | Delete |
--| |==================================|
--|
procedure Delete(In_The_Tree : in out Bin_Tree_Type;
A_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type)
is
--|
--|
--|
type Delete_Direction_Type is
(Top,
Left,
Right);
Local_Tree : Bin_Tree_Type;
Temporary_Tree : Bin_Tree_Type := In_The_Tree;
Delete_Direction : Delete_Direction_Type := Top;
--|
--| |==================================|
--| | Node_Delete |
--| |==================================|
--|
function Node_Delete(From_The_Tree : in Bin_Tree_Type) return
Bin_Tree_Type
is
Temporary_Tree : Bin_Tree_Type;
begin
--|
--|
--|
if From_The_Tree.Left = null
then
return From_The_Tree.Right;
--|
--|
--|
else
Temporary_Tree := From_The_Tree.Left;
--|
--|
--|
while Temporary_Tree.Right /= null loop
Temporary_Tree := Temporary_Tree.Right;
end loop;
--|
--|
--|
Temporary_Tree.Right := From_The_Tree.Right;
return From_The_Tree.Left;
end if;
end Node_Delete;
--|
--| |==================================|
--| | MAIN Delete |
--| |==================================|
--|
begin
--|
--|
--|
loop
--|
--|
--|
if Temporary_Tree = null
then
Result_Code := Not_Found;
return;
--|
--|
--|
elsif Temporary_Tree.The_Data.all < A_Data
then
Local_Tree := Temporary_Tree;
Delete_Direction := Right;
Temporary_Tree := Temporary_Tree.Right;
--|
--|
--|
elsif A_Data < Temporary_Tree.The_Data.all
then
Local_Tree := Temporary_Tree;
Delete_Direction := Left;
Temporary_Tree := Temporary_Tree.Left;
--|
--|
--|
else
Result_Code := Success;
exit;
end if;
end loop;
--|
--|
--|
case Delete_Direction is
--|
--|
--|
when Top =>
In_The_Tree := Node_Delete(From_The_Tree => Temporary_Tree);
--|
--|
--|
when Left =>
Local_Tree.Left := Node_Delete(From_The_Tree => Temporary_Tree);
--|
--|
--|
when Right =>
Local_Tree.Right := Node_Delete(From_The_Tree => Temporary_Tree);
end case;
end Delete;
end Poly_Bin_Tree;
next reply other threads:[~2001-06-04 12:50 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2001-06-04 12:50 daniel gaudry [this message]
2001-06-04 22:18 ` Specification does not compile Mark Johnson
2001-06-04 23:21 ` Keith Thompson
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox