|
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: 18750 (0x493e)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
with Instance;
with Unbounded_Array;
package body Collection is
package Unbounded_Collection is
new Unbounded_Array (Element => Instance.Reference,
Content => Collection.Object);
package Uc renames Unbounded_Collection;
------------------------------------------------------------------------------
function Null_Object return Collection.Object is
Result : Uc.Object;
begin
declare
A_Collection : constant Collection.Object := Uc.Get (Result);
begin
Uc.Free (Result);
return A_Collection;
end;
end Null_Object;
------------------------------------------------------------------------------
function Restrict (The_Collection : Collection.Object;
For_Quantity : Natural := Instance.Any)
return Collection.Object is
An_Object : Uc.Object;
Count : Natural := 0;
begin
if Cardinality (The_Collection) /= 0 then
for I in The_Collection'First .. The_Collection'Last loop
if Predicate (With_Reference => The_Collection (I)) then
An_Object := Uc."&" (An_Object, The_Collection (I));
Count := Count + 1;
end if;
if For_Quantity /= Instance.Any and Count >= For_Quantity then
exit;
end if;
end loop;
end if;
declare
A_Collection : constant Collection.Object := Uc.Get (An_Object);
begin
Uc.Free (An_Object);
return A_Collection;
end;
end Restrict;
------------------------------------------------------------------------------
function Find_One (The_Collection : Collection.Object)
return Instance.Reference is
A_Reference : Instance.Reference := Instance.Null_Reference;
begin
if Cardinality (The_Collection) /= 0 then
for I in The_Collection'First .. The_Collection'Last loop
if Predicate (With_Reference => The_Collection (I)) then
A_Reference := The_Collection (I);
exit;
end if;
end loop;
end if;
return A_Reference;
end Find_One;
------------------------------------------------------------------------------
function Exist (The_Collection : Collection.Object) return Boolean is
Is_Found : Boolean := False;
begin
if Cardinality (The_Collection) /= 0 then
for I in The_Collection'First .. The_Collection'Last loop
if Predicate (With_Reference => The_Collection (I)) then
Is_Found := True;
exit;
end if;
end loop;
end if;
return Is_Found;
end Exist;
------------------------------------------------------------------------------
function The_Most (Of_Collection : Collection.Object)
return Instance.Reference is
A_Reference : Instance.Reference := Instance.Null_Reference;
begin
if Cardinality (Of_Collection) /= 0 then
A_Reference := Of_Collection (Of_Collection'First);
for I in Of_Collection'First + 1 .. Of_Collection'Last loop
if not Predicate (The_Best => A_Reference,
Any_Other => Of_Collection (I)) then
A_Reference := Of_Collection (I);
end if;
end loop;
end if;
return A_Reference;
end The_Most;
------------------------------------------------------------------------------
function Cardinality (Of_Collection : Collection.Object) return Natural is
begin
return Of_Collection'Last - Of_Collection'First + 1;
end Cardinality;
------------------------------------------------------------------------------
function Is_Null (The_Collection : Collection.Object) return Boolean is
begin
return Cardinality (The_Collection) = 0;
end Is_Null;
------------------------------------------------------------------------------
function Add (In_Collection : Collection.Object;
The_Reference : Instance.Reference)
return Collection.Object is
Result : Uc.Object;
begin
Result := Uc.Create (In_Collection);
if not Is_Member (Of_Collection => In_Collection,
The_Reference => The_Reference) then
Result := Uc."&" (Result, The_Reference);
end if;
declare
A_Collection : constant Collection.Object := Uc.Get (Result);
begin
Uc.Free (Result);
return A_Collection;
end;
end Add;
------------------------------------------------------------------------------
function Remove (In_Collection : Collection.Object;
The_Reference : Instance.Reference)
return Collection.Object is
Result : Uc.Object;
begin
Result := Uc.Create (In_Collection);
if Cardinality (In_Collection) /= 0 then
for I in In_Collection'First .. In_Collection'Last loop
if Instance."=" (In_Collection (I), The_Reference) then
Uc.Remove (In_Object => Result, The_Item => I);
exit;
end if;
end loop;
end if;
declare
A_Collection : constant Collection.Object := Uc.Get (Result);
begin
Uc.Free (Result);
return A_Collection;
end;
end Remove;
------------------------------------------------------------------------------
function Remove (In_Collection : Collection.Object; The_Item : Natural)
return Collection.Object is
Result : Uc.Object;
begin
Result := Uc.Create (In_Collection);
if The_Item >= In_Collection'First and
The_Item <= In_Collection'Last then
Uc.Remove (In_Object => Result, The_Item => The_Item);
end if;
declare
A_Collection : constant Collection.Object := Uc.Get (Result);
begin
Uc.Free (Result);
return A_Collection;
end;
end Remove;
------------------------------------------------------------------------------
procedure Clear (The_Collection : in out Collection.Object) is
Result : Uc.Object;
A_Collection : constant Collection.Object := Uc.Get (Result);
begin
The_Collection := A_Collection;
end Clear;
------------------------------------------------------------------------------
function Union (Collection1 : Collection.Object;
Collection2 : Collection.Object) return Collection.Object is
Result : Uc.Object;
Temporary : Uc.Object;
Temporary_Collection :
Collection.Object (1 .. Cardinality (Collection2)) := Collection2;
Count : Natural := Cardinality (Collection2);
begin
--[a revoir]
if Cardinality (Collection1) = 0 then
Result := Uc.Create (The_Content => Collection2);
elsif Cardinality (Collection2) = 0 then
Result := Uc.Create (The_Content => Collection1);
else
for I in Collection1'First .. Collection1'Last loop
for J in 1 .. Temporary_Collection'Last loop
if Instance."=" (Collection1 (I),
Temporary_Collection (J)) then
Temporary_Collection :=
Remove (In_Collection => Temporary_Collection,
The_Item => J);
Count := Count - 1;
exit;
end if;
end loop;
end loop;
Result := Uc.Create (The_Content => Collection1);
Temporary := Uc.Create (The_Content =>
Temporary_Collection (1 .. Count));
Result := Uc."&" (Result, Temporary);
Uc.Free (Temporary);
end if;
declare
A_Collection : constant Collection.Object := Uc.Get (Result);
begin
Uc.Free (Result);
return A_Collection;
end;
end Union;
------------------------------------------------------------------------------
function Maximum_Of (Integer_1, And_Integer_2 : Integer) return Integer is
begin
if Integer_1 > And_Integer_2 then
return Integer_1;
else
return And_Integer_2;
end if;
end Maximum_Of;
------------------------------------------------------------------------------
function Intersection (Collection1 : Collection.Object;
Collection2 : Collection.Object)
return Collection.Object is
Result : Uc.Object;
begin
--[a revoir]
if Cardinality (Collection1) /= 0 and
Cardinality (Collection2) /= 0 then
for I in Collection1'First .. Collection1'Last loop
for J in Collection2'First .. Collection2'Last loop
if Instance."=" (Collection1 (I), Collection2 (J)) then
Result := Uc."&" (Result, Collection1 (I));
exit;
end if;
end loop;
end loop;
end if;
declare
A_Collection : constant Collection.Object := Uc.Get (Result);
begin
Uc.Free (Result);
return A_Collection;
end;
end Intersection;
------------------------------------------------------------------------------
function Difference (Collection1 : Collection.Object;
Collection2 : Collection.Object)
return Collection.Object is
Result : Uc.Object;
Temporary_Collection :
Collection.Object (1 .. Cardinality (Collection1)) := Collection1;
Count : Natural := Cardinality (Collection1);
begin
--[a verifier]
if not Is_Null (The_Collection => Collection2) then
for I in Collection1'First .. Collection1'Last loop
for J in Collection2'First .. Collection2'Last loop
if Instance."=" (Collection1 (I), Collection2 (J)) then
Temporary_Collection :=
Remove (In_Collection => Temporary_Collection,
The_Reference => Collection1 (I));
Count := Count - 1;
exit;
end if;
end loop;
end loop;
end if;
Result := Uc.Create (Temporary_Collection (1 .. Count));
declare
A_Collection : constant Collection.Object := Uc.Get (Result);
begin
Uc.Free (Result);
return A_Collection;
end;
end Difference;
------------------------------------------------------------------------------
function Is_Member (Of_Collection : Collection.Object;
The_Reference : Instance.Reference) return Boolean is
Found : Boolean := False;
begin
if Cardinality (Of_Collection) = 0 then
Found := False;
else
for I in Of_Collection'First .. Of_Collection'Last loop
if Instance."=" (The_Reference, Of_Collection (I)) then
Found := True;
exit;
end if;
end loop;
end if;
return Found;
end Is_Member;
------------------------------------------------------------------------------
function Is_Include (Collection1 : Collection.Object;
Collection2 : Collection.Object) return Boolean is
Include : Boolean := False;
Checkcoll : Boolean := False;
begin
if Cardinality (Collection1) = 0 then
Include := True;
elsif (Cardinality (Collection2) /= 0) then
Include := True;
for I in Collection1'First .. Collection1'Last loop
for J in Collection2'First .. Collection2'Last loop
if Instance."=" (Collection1 (I), Collection2 (J)) then
Checkcoll := True;
exit;
end if;
end loop;
if Checkcoll = False then
Include := False;
exit;
else
Checkcoll := False;
end if;
end loop;
end if;
return Include;
end Is_Include;
function ">" (Collection1 : Collection.Object;
Collection2 : Collection.Object) return Boolean is
begin
return Is_Include (Collection2, Collection1);
end ">";
------------------------------------------------------------------------------
function Object_To_Collection
(The_Reference : Instance.Reference) return Collection.Object is
Result_Collection : Collection.Object (1 .. 1);
begin
Result_Collection (1) := The_Reference;
return Result_Collection;
end Object_To_Collection;
------------------------------------------------------------------------------
function Get (In_Collection : Collection.Object;
The_Position : Positive := 1) return Instance.Reference is
A_Reference : Instance.Reference := Instance.Null_Reference;
begin
if The_Position >= In_Collection'First and
The_Position <= In_Collection'Last then
A_Reference := In_Collection (The_Position);
end if;
return A_Reference;
end Get;
------------------------------------------------------------------------------
function Get (In_Collection : Collection.Object;
From_Position : Positive := 1;
To_Position : Positive)
return Collection.Object is
Result : Uc.Object;
From_Limit : Natural;
To_Limit : Natural;
begin
if To_Position > In_Collection'Last then
To_Limit := In_Collection'Last;
else
To_Limit := To_Position;
end if;
if From_Position < In_Collection'First then
From_Limit := In_Collection'First;
else
From_Limit := From_Position;
end if;
Result := Uc.Create (In_Collection (From_Limit .. To_Limit));
declare
A_Collection : constant Collection.Object := Uc.Get (Result);
begin
Uc.Free (Result);
return A_Collection;
end;
end Get;
------------------------------------------------------------------------------
function First (Of_Collection : Collection.Object)
return Instance.Reference is
begin
if Cardinality (Of_Collection) /= 0 then
return Of_Collection (Of_Collection'First);
end if;
end First;
------------------------------------------------------------------------------
function Rest (Of_Collection : Collection.Object)
return Collection.Object is
Result : Uc.Object;
begin
Result := Uc.Create (Of_Collection (Of_Collection'First + 1 ..
Of_Collection'Last));
declare
A_Collection : constant Collection.Object := Uc.Get (Result);
begin
Uc.Free (Result);
return A_Collection;
end;
end Rest;
------------------------------------------------------------------------------
procedure Do_For_All (The_Collection : Collection.Object) is
begin
for I in The_Collection'First .. The_Collection'Last loop
Action (The_Collection (I));
end loop;
end Do_For_All;
------------------------------------------------------------------------------
procedure Sort (The_Collection : in out Collection.Object) is
Index : Integer range The_Collection'First - 1 .. The_Collection'Last;
A_Reference : Instance.Reference;
begin
--[a verifier]
for I in The_Collection'First + 1 .. The_Collection'Last - 1 loop
A_Reference := The_Collection (I);
Index := I - 1;
while (Index /= The_Collection'First - 1) and then
(A_Reference < The_Collection (Index)) loop
The_Collection (Index + 1) := The_Collection (Index);
Index := Index - 1;
end loop;
The_Collection (Index + 1) := A_Reference;
end loop;
end Sort;
------------------------------------------------------------------------------
package body Iterator is
function Open (The_Collection : Collection.Object) return Iterator is
begin
if Cardinality (The_Collection) = 0 then
return 0;
else
return Iterator (The_Collection'First);
end if;
end Open;
function Get (Of_Collection : Collection.Object;
The_Iterator : Iterator) return Instance.Reference is
Index : Positive;
begin
Index := Positive (The_Iterator);
if Index > Of_Collection'Last or Index < Of_Collection'First then
raise Illegal_Access;
end if;
return Of_Collection (Index);
exception
when Constraint_Error =>
raise Illegal_Access;
end Get;
function Next (Of_Collection : Collection.Object;
With_Iterator : Iterator) return Iterator is
Index : Positive;
An_Iterator : Iterator;
begin
Index := Positive (With_Iterator) + 1;
if Index > Of_Collection'Last or Index < Of_Collection'First then
An_Iterator := Iterator (0);
else
An_Iterator := Iterator (Index);
end if;
return An_Iterator;
exception
when Constraint_Error =>
raise Illegal_Access;
end Next;
function At_End (Of_Collection : Collection.Object;
With_Iterator : Iterator) return Boolean is
begin
return With_Iterator = 0;
end At_End;
end Iterator;
end Collection;