|
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 - metrics - downloadIndex: B T
Length: 7815 (0x1e87)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
--
-- (C) Copyright 1987 Grady Booch
-- All Rights Reserved
--
-- Serial Number R000000
--
package body Set_Simple_Sequential_Bounded_Managed_Iterator is
procedure Copy (From_The_Set : in Set; To_The_Set : in out Set) is
begin
if From_The_Set.The_Back > To_The_Set.The_Size then
raise Overflow;
else
To_The_Set.The_Items (1 .. From_The_Set.The_Back) :=
From_The_Set.The_Items (1 .. From_The_Set.The_Back);
To_The_Set.The_Back := From_The_Set.The_Back;
end if;
end Copy;
procedure Clear (The_Set : in out Set) is
begin
The_Set.The_Back := 0;
end Clear;
procedure Add (The_Item : in Item; To_The_Set : in out Set) is
begin
for Index in 1 .. To_The_Set.The_Back loop
if The_Item = To_The_Set.The_Items (Index) then
raise Item_Is_In_Set;
end if;
end loop;
To_The_Set.The_Items (To_The_Set.The_Back + 1) := The_Item;
To_The_Set.The_Back := To_The_Set.The_Back + 1;
exception
when Constraint_Error =>
raise Overflow;
end Add;
procedure Remove (The_Item : in Item; From_The_Set : in out Set) is
begin
for Index in 1 .. From_The_Set.The_Back loop
if The_Item = From_The_Set.The_Items (Index) then
From_The_Set.The_Items (Index .. (From_The_Set.The_Back - 1)) :=
From_The_Set.The_Items ((Index + 1) ..
From_The_Set.The_Back);
From_The_Set.The_Back := From_The_Set.The_Back - 1;
return;
end if;
end loop;
raise Item_Is_Not_In_Set;
end Remove;
procedure Union (Of_The_Set : in Set;
And_The_Set : in Set;
To_The_Set : in out Set) is
To_Index : Natural;
To_Back : Natural;
begin
To_The_Set.The_Items (1 .. Of_The_Set.The_Back) :=
Of_The_Set.The_Items (1 .. Of_The_Set.The_Back);
To_The_Set.The_Back := Of_The_Set.The_Back;
To_Back := To_The_Set.The_Back;
for And_Index in 1 .. And_The_Set.The_Back loop
To_Index := To_Back;
while To_Index > 0 loop
if To_The_Set.The_Items (To_Index) =
And_The_Set.The_Items (And_Index) then
exit;
else
To_Index := To_Index - 1;
end if;
end loop;
if To_Index = 0 then
To_The_Set.The_Items (To_The_Set.The_Back + 1) :=
And_The_Set.The_Items (And_Index);
To_The_Set.The_Back := To_The_Set.The_Back + 1;
end if;
end loop;
exception
when Constraint_Error =>
raise Overflow;
end Union;
procedure Intersection (Of_The_Set : in Set;
And_The_Set : in Set;
To_The_Set : in out Set) is
And_Index : Natural;
begin
To_The_Set.The_Back := 0;
for Of_Index in 1 .. Of_The_Set.The_Back loop
And_Index := And_The_Set.The_Back;
while And_Index > 0 loop
if Of_The_Set.The_Items (Of_Index) =
And_The_Set.The_Items (And_Index) then
To_The_Set.The_Items (To_The_Set.The_Back + 1) :=
Of_The_Set.The_Items (Of_Index);
To_The_Set.The_Back := To_The_Set.The_Back + 1;
exit;
else
And_Index := And_Index - 1;
end if;
end loop;
end loop;
exception
when Constraint_Error =>
raise Overflow;
end Intersection;
procedure Difference (Of_The_Set : in Set;
And_The_Set : in Set;
To_The_Set : in out Set) is
And_Index : Natural;
begin
To_The_Set.The_Back := 0;
for Of_Index in 1 .. Of_The_Set.The_Back loop
And_Index := And_The_Set.The_Back;
while And_Index > 0 loop
if Of_The_Set.The_Items (Of_Index) =
And_The_Set.The_Items (And_Index) then
exit;
else
And_Index := And_Index - 1;
end if;
end loop;
if And_Index = 0 then
To_The_Set.The_Items (To_The_Set.The_Back + 1) :=
Of_The_Set.The_Items (Of_Index);
To_The_Set.The_Back := To_The_Set.The_Back + 1;
end if;
end loop;
exception
when Constraint_Error =>
raise Overflow;
end Difference;
function Is_Equal (Left : in Set; Right : in Set) return Boolean is
Right_Index : Natural;
begin
if Left.The_Back /= Right.The_Back then
return False;
else
for Left_Index in 1 .. Left.The_Back loop
Right_Index := Right.The_Back;
while Right_Index > 0 loop
if Left.The_Items (Left_Index) =
Right.The_Items (Right_Index) then
exit;
else
Right_Index := Right_Index - 1;
end if;
end loop;
if Right_Index = 0 then
return False;
end if;
end loop;
return True;
end if;
end Is_Equal;
function Extent_Of (The_Set : in Set) return Natural is
begin
return The_Set.The_Back;
end Extent_Of;
function Is_Empty (The_Set : in Set) return Boolean is
begin
return (The_Set.The_Back = 0);
end Is_Empty;
function Is_A_Member
(The_Item : in Item; Of_The_Set : in Set) return Boolean is
begin
for Index in 1 .. Of_The_Set.The_Back loop
if Of_The_Set.The_Items (Index) = The_Item then
return True;
end if;
end loop;
return False;
end Is_A_Member;
function Is_A_Subset (Left : in Set; Right : in Set) return Boolean is
Right_Index : Natural;
begin
for Left_Index in 1 .. Left.The_Back loop
Right_Index := Right.The_Back;
while Right_Index > 0 loop
if Left.The_Items (Left_Index) =
Right.The_Items (Right_Index) then
exit;
else
Right_Index := Right_Index - 1;
end if;
end loop;
if Right_Index = 0 then
return False;
end if;
end loop;
return True;
end Is_A_Subset;
function Is_A_Proper_Subset
(Left : in Set; Right : in Set) return Boolean is
Right_Index : Natural;
begin
for Left_Index in 1 .. Left.The_Back loop
Right_Index := Right.The_Back;
while Right_Index > 0 loop
if Left.The_Items (Left_Index) =
Right.The_Items (Right_Index) then
exit;
else
Right_Index := Right_Index - 1;
end if;
end loop;
if Right_Index = 0 then
return False;
end if;
end loop;
return (Left.The_Back < Right.The_Back);
end Is_A_Proper_Subset;
procedure Iterate (Over_The_Set : in Set) is
Continue : Boolean;
begin
for The_Iterator in 1 .. Over_The_Set.The_Back loop
Process (Over_The_Set.The_Items (The_Iterator), Continue);
exit when not Continue;
end loop;
end Iterate;
end Set_Simple_Sequential_Bounded_Managed_Iterator;