|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 8655 (0x21cf)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
-------------------------------------------------------------------------------
with Table_Sort_Generic;
with Text_Io;
package body Static_List_Generic is
---------------------------------------------------------------------------
function Is_Full (The_Object : Object) return Boolean is
begin
return (The_Object.Size = The_Object.The_Table'Last);
end Is_Full;
---------------------------------------------------------------------------
function Add (X : Element; Into : Object) return Object is
begin
if (Is_Full (Into)) then
raise Full_Error;
end if;
declare
L_Bis : Object := Into;
begin
L_Bis.The_Table (L_Bis.Size + 1) := X;
L_Bis.Size := Natural'Succ (L_Bis.Size);
return L_Bis;
end;
end Add;
---------------------------------------------------------------------------
function Null_Object return Object is
The_List : Object;
begin
The_List.Size := 0;
return The_List;
end Null_Object;
---------------------------------------------------------------------------
function Is_Empty (The_Object : Object) return Boolean is
begin
return (The_Object.Size = 0);
end Is_Empty;
---------------------------------------------------------------------------
procedure Free (The_Object : in out Object) is
begin
The_Object.Size := 0;
end Free;
---------------------------------------------------------------------------
function First (The_Object : Object) return Element is
begin
if (Is_Empty (The_Object)) then
raise Empty_Error;
end if;
return (The_Object.The_Table (The_Object.Size));
end First;
---------------------------------------------------------------------------
function Rest (The_Object : Object) return Object is
begin
if (Is_Empty (The_Object)) then
raise Empty_Error;
end if;
declare
L_Bis : Object := The_Object;
begin
L_Bis.Size := Natural'Pred (L_Bis.Size);
return L_Bis;
end;
end Rest;
---------------------------------------------------------------------------
procedure Set_Rest (The_Object : in out Object; To_Be : Object) is
begin
if (Is_Empty (The_Object)) then
raise Empty_Error;
end if;
if (Is_Full (To_Be)) then
raise Full_Error;
end if;
The_Object := Add (First (The_Object), To_Be);
end Set_Rest;
---------------------------------------------------------------------------
procedure Set_First (The_Object : in out Object; To_Be : Element) is
begin
if (Is_Empty (The_Object)) then
raise Empty_Error;
end if;
The_Object.The_Table (The_Object.Size) := To_Be;
end Set_First;
---------------------------------------------------------------------------
function Length (The_Object : Object) return Natural is
begin
return (The_Object.Size);
end Length;
---------------------------------------------------------------------------
procedure Sort (The_Object : in out Object) is
begin
declare
subtype Index_Table is Index range 1 .. Length (The_Object);
type Table_Element is array (Index_Table range <>) of Element;
procedure Table_Sort is
new Table_Sort_Generic (Element => Element,
Index => Index_Table,
Element_Array => Table_Element,
"<" => "<");
The_Table : Table_Element (Index_Table);
begin
for I in Index_Table loop
The_Table (I) := The_Object.The_Table (I);
end loop;
Table_Sort (The_Table);
for I in Index_Table loop
The_Object.The_Table (Index_Table'Last - I + 1) :=
The_Table (I);
end loop;
end;
end Sort;
---------------------------------------------------------------------------
procedure Init (Iter : out Iterator; The_Object : Object) is
begin
if (Length (The_Object) = 0) then
Iter.Index_Value := 1;
Iter.Done := True;
else
Iter.Index_Value := Length (The_Object);
Iter.Done := False;
end if;
end Init;
---------------------------------------------------------------------------
procedure Next (Iter : in out Iterator; The_Object : Object) is
begin
if (not Iter.Done) then
if (Iter.Index_Value = The_Object.The_Table'First) then
Iter.Done := True;
else
Iter.Index_Value := Natural'Pred (Iter.Index_Value);
end if;
end if;
end Next;
---------------------------------------------------------------------------
function Value (Iter : Iterator; The_Object : Object) return Element is
begin
return (The_Object.The_Table (Iter.Index_Value));
end Value;
---------------------------------------------------------------------------
function Done (Iter : Iterator; The_Object : Object) return Boolean is
begin
return (Iter.Done);
end Done;
---------------------------------------------------------------------------
function Image (The_Object : Object) return String is
Iter : Iterator;
begin
declare
function In_Text (Iter : Iterator) return String is
begin
if (Done (Iter, The_Object)) then
return "";
end if;
declare
The_Element : Element := Value (Iter, The_Object);
Iter_Bis : Iterator := Iter;
begin
Next (Iter_Bis, The_Object);
if (not Done (Iter_Bis, The_Object)) then
return Image (The_Element) & Separator &
In_Text (Iter_Bis);
else
return Image (The_Element);
end if;
end;
end In_Text;
begin
Init (Iter, The_Object);
return Natural'Image (Length (The_Object)) &
Separator & In_Text (Iter);
end;
end Image;
---------------------------------------------------------------------------
procedure Display (The_Object : Object; String_Before : String := "") is
Iter : Iterator;
begin
Text_Io.Put_Line (String_Before & "The_Object =>");
Text_Io.Put_Line (String_Before & " Size => " &
Natural'Image (Length (The_Object)));
Text_Io.Put_Line (String_Before & " Elements => ");
Init (Iter, The_Object);
while not Done (Iter, The_Object) loop
Display (Value (Iter, The_Object), String_Before & " ");
Next (Iter, The_Object);
end loop;
end Display;
---------------------------------------------------------------------------
function Is_Equal (Left, Right : Object) return Boolean is
Iter_Left : Iterator;
Iter_Right : Iterator;
begin
Init (Iter_Left, Left);
Init (Iter_Right, Right);
while (not Done (Iter_Left, Left) and not Done (Iter_Right, Right)) loop
if (not Is_Equal (Value (Iter_Left, Left),
Value (Iter_Right, Right))) then
return False;
end if;
Next (Iter_Left, Left);
Next (Iter_Right, Right);
end loop;
return Done (Iter_Left, Left) and Done (Iter_Right, Right);
end Is_Equal;
---------------------------------------------------------------------------
function Is_Element (The_Element : Element; Of_The_Object : Object)
return Boolean is
Iter : Iterator;
begin
Init (Iter, Of_The_Object);
while (not Done (Iter, Of_The_Object)) loop
if (Is_Equal (Value (Iter, Of_The_Object), The_Element)) then
return True;
end if;
Next (Iter, Of_The_Object);
end loop;
return False;
end Is_Element;
end Static_List_Generic;
-------------------------------------------------------------------------------