|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 19456 (0x4c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Collection, package body Iterator, seg_00dc67, separate Expertsystem
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Instancecounter;
separate (Expertsystem)
package body Collection is
function Defaultname (Aref : Expertsystem.Reference) return Objectname is
Limage : constant String := Ido'Image (Aref.Idobject);
Limage2 : Objectname;
begin
Limage2 (1 .. Limage'Length) := Limage (1 .. Limage'Length);
for I in Natural (Limage'Length + 1) .. Natural (Classname'Length) loop
Limage2 (I) := ' ';
end loop;
return (Limage2);
end Defaultname;
function Restrict (Thecollection : Collection.Object;
Quantity : Natural := Any) return Collection.Object is
Result : Object (Thecollection.Size);
begin
if Thecollection.Count /= 0 then
for I in 1 .. Thecollection.Count loop
if Predicate (Thecollection.Cells (I)) then
Add (Result, Thecollection.Cells (I));
if (Quantity /= Any) and then
(Result.Count >= Quantity) then
return Result;
end if;
end if;
end loop;
end if;
return Result;
end Restrict;
function Findone (Thecollection : Collection.Object)
return Expertsystem.Reference is
begin
if Thecollection.Count /= 0 then
for I in 1 .. Thecollection.Count loop
if Predicate (Thecollection.Cells (I)) then
return (Thecollection.Cells (I));
end if;
end loop;
end if;
return Nullreference;
end Findone;
function Notexist (Thecollection : Collection.Object) return Boolean is
begin
if Thecollection.Count /= 0 then
for I in 1 .. Thecollection.Count loop
if Predicate (Thecollection.Cells (I)) then
return (False);
end if;
end loop;
end if;
return (True);
end Notexist;
function Exist (Thecollection : Collection.Object) return Boolean is
begin
if Thecollection.Count /= 0 then
for I in 1 .. Thecollection.Count loop
if Predicate (Thecollection.Cells (I)) then
return (True);
end if;
end loop;
end if;
return (False);
end Exist;
function Themost (Thecollection : Collection.Object)
return Expertsystem.Reference is
Ref : Expertsystem.Reference;
begin
if Thecollection.Count = 0 then
return Nullreference;
end if;
Ref := Thecollection.Cells (1);
for I in 2 .. Thecollection.Count loop
if not Predicate (Ref, Thecollection.Cells (I)) then
Ref := Thecollection.Cells (I);
end if;
end loop;
return Ref;
end Themost;
function Cardinality (Thecollection : Collection.Object) return Natural is
begin
return Thecollection.Count;
end Cardinality;
function Isfull (Thecollection : Collection.Object) return Boolean is
begin
return Thecollection.Count = Thecollection.Size;
end Isfull;
function Isnull (Thecollection : Collection.Object) return Boolean is
begin
return Thecollection.Count = 0;
end Isnull;
function Isnotnull (Thecollection : Collection.Object) return Boolean is
begin
return Thecollection.Count /= 0;
end Isnotnull;
function Isnull (Aref : Expertsystem.Reference) return Boolean is
begin
return Aref = Nullreference;
end Isnull;
function Isnotnull (Aref : Expertsystem.Reference) return Boolean is
begin
return Aref /= Nullreference;
end Isnotnull;
procedure Add (Thecollection : in out Object;
Aref : in Expertsystem.Reference) is
Alreadyexist : Boolean := False;
begin
if (Thecollection.Count /= 0) and then
(Aref.Idclass /= Thecollection.Cells (1).Idclass) then
raise Badclass;
end if;
if Isfull (Thecollection) then
declare
Collection1 : Collection.Object
(Thecollection.Size + Thecollection.Size / 2);
begin
Collection1.Cells (1 .. Thecollection.Size) :=
Thecollection.Cells (1 .. Thecollection.Size);
Collection1.Count := Thecollection.Count;
Collection1.Unity := Thecollection.Unity;
Thecollection := Collection1;
end;
end if;
for I in 1 .. Thecollection.Count loop
if Aref.Idobject = Thecollection.Cells (I).Idobject then
Alreadyexist := True;
end if;
end loop;
if not Alreadyexist then
Thecollection.Count := Thecollection.Count + 1;
Thecollection.Cells (Thecollection.Count) := Aref;
end if;
end Add;
procedure Remove (Thecollection : in out Collection.Object;
Aref : in Expertsystem.Reference) is
begin
if (Thecollection.Count /= 0) and then
Thecollection.Cells (1).Idclass = Aref.Idclass then
for I in 1 .. Thecollection.Count loop
if Thecollection.Cells (I).Idobject = Aref.Idobject then
for J in I .. Thecollection.Count - 1 loop
Thecollection.Cells (J) := Thecollection.Cells (J + 1);
end loop;
Thecollection.Count := Thecollection.Count - 1;
exit;
end if;
end loop;
end if;
end Remove;
procedure Update (Thecollection : in out Collection.Object; Aref : in Expertsystem.Reference) is
begin
if (Thecollection.Count /= 0) and then
Thecollection.Cells (1).Idclass = Aref.Idclass then
for I in 1 .. Thecollection.Count loop
if Thecollection.Cells (I).Idobject = Aref.Idobject then
Thecollection.Cells (I).Date := Instancecounter.Newobject;
exit;
end if;
end loop;
end if;
end Update;
procedure Update (Thecollection : in out Collection.Object;
Aref : in Expertsystem.Reference;
Withdate : in Long_Integer) is
begin
if (Thecollection.Count /= 0) and then
Thecollection.Cells (1).Idclass = Aref.Idclass then
for I in 1 .. Thecollection.Count loop
if Thecollection.Cells (I).Idobject = Aref.Idobject then
Thecollection.Cells (I).Date := Withdate;
exit;
end if;
end loop;
end if;
end Update;
procedure Updateall (Thecollection : in out Collection.Object) is
Adate : Long_Integer;
begin
Adate := Instancecounter.Newobject;
for I in 1 .. Thecollection.Count loop
Thecollection.Cells (I).Date := Adate;
end loop;
end Updateall;
procedure Clear (Thecollection : in out Collection.Object) is
begin
Thecollection.Count := 0;
Thecollection.Unity := 1;
end Clear;
function Union (Collection1 : Collection.Object;
Collection2 : Collection.Object) return Collection.Object is
Result : Collection.Object (Collection1.Size + Collection2.Size);
Tampon : Collection.Object (Collection2.Size);
begin
if Collection1.Count = 0 then
Result := Collection2;
elsif Collection2.Count = 0 then
Result := Collection1;
else
if Collection1.Cells (1).Idclass /=
Collection2.Cells (1).Idclass then
raise Badclass;
else
Tampon := Collection2;
for I in 1 .. Collection1.Count loop
for J in 1 .. Tampon.Count loop
if Collection1.Cells (I).Idobject =
Tampon.Cells (J).Idobject then
Remove (Tampon, Tampon.Cells (J));
exit;
end if;
end loop;
Add (Result, Collection1.Cells (I));
end loop;
Result.Count := Result.Count + Tampon.Count;
Result.Cells (1 .. Result.Count + Tampon.Count) :=
Result.Cells (1 .. Result.Count) &
Tampon.Cells (1 .. Tampon.Count);
end if;
end if;
return Result;
end Union;
function Max (Int1, Int2 : Integer) return Integer is
begin
if Int1 > Int2 then
return Int1;
else
return Int2;
end if;
end Max;
function Intersection (Collection1 : Collection.Object;
Collection2 : Collection.Object)
return Collection.Object is
Result : Collection.Object (Max (Collection1.Size, Collection2.Size));
Tampon : Collection.Object (Collection2.Size);
begin
if (Collection1.Count /= 0) and (Collection2.Count /= 0) then
if (Collection1.Cells (1).Idclass /=
Collection2.Cells (1).Idclass) then
raise Badclass;
else
Tampon := Collection2;
for I in 1 .. Collection1.Count loop
for J in 1 .. Tampon.Count loop
if Collection1.Cells (I).Idobject =
Tampon.Cells (J).Idobject then
Remove (Tampon, Tampon.Cells (J));
Add (Result, Collection1.Cells (I));
exit;
end if;
end loop;
end loop;
end if;
end if;
return Result;
end Intersection;
function Difference (Collection1 : Collection.Object;
Collection2 : Collection.Object)
return Collection.Object is
Result : Collection.Object (Collection1.Size);
begin
if Collection2.Count = 0 then
Result := Collection1;
elsif (Collection1.Count /= 0) then
if (Collection1.Cells (1).Idclass /=
Collection2.Cells (1).Idclass) then
raise Badclass;
else
Result := Collection1;
for I in 1 .. Collection1.Count loop for J in 1 .. Collection2.Count loop
if Collection1.Cells (I).Idobject =
Collection2.Cells (J).Idobject then
Remove (Result, Collection1.Cells (I));
exit;
end if;
end loop;
end loop;
end if;
end if;
return Result;
end Difference;
function Member (Thecollection : Collection.Object;
Aref : Expertsystem.Reference) return Boolean is
Found : Boolean := False;
begin
if Thecollection.Count = 0 then
Found := False;
elsif (Aref.Idclass /= Thecollection.Cells (1).Idclass) then
Found := False;
else
for I in 1 .. Thecollection.Count loop
if Aref.Idobject = Thecollection.Cells (I).Idobject then
Found := True;
exit;
end if;
end loop;
end if;
return Found;
end Member;
function Isinclude (Collection1 : Collection.Object;
Collection2 : Collection.Object) return Boolean is
Include : Boolean := False;
Checkcoll : Boolean := False;
begin
if Collection1.Count = 0 then
Include := True;
elsif (Collection2.Count /= 0) and (Collection1.Cells (1).Idclass =
Collection2.Cells (1).Idclass) then
Include := True;
for I in 1 .. Collection1.Count loop
for J in 1 .. Collection2.Count loop
if Collection1.Cells (I).Idobject =
Collection2.Cells (J).Idobject 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 Isinclude;
function ">" (Collection1 : Collection.Object;
Collection2 : Collection.Object) return Boolean is
begin
return Isinclude (Collection2, Collection1);
end ">";
function Asobject (Aref : Expertsystem.Reference)
return Collection.Object is
Result : Collection.Object;
begin
Add (Result, Aref);
return Result;
end Asobject;
function Get (Thecollection : Collection.Object; Number : Positive := 1)
return Expertsystem.Reference is
begin
if Number > Thecollection.Count then
return Nullreference;
else
return Thecollection.Cells (Number);
end if;
end Get;
function First (Thecollection : Collection.Object)
return Expertsystem.Reference is
begin
return Get (Thecollection, 1);
end First;
function Rest (Thecollection : Collection.Object)
return Collection.Object is
Acollection : Collection.Object;
begin
Acollection := Thecollection;
Collection.Remove (Acollection, Get (Thecollection, 1));
return (Acollection);
end Rest;
function Get (Thecollection : Collection.Object;
Frompos : Positive := 1;
Topos : Positive) return Collection.Object is
Result : Collection.Object;
Bornefrom : Natural;
Borneto : Natural;
begin
if Topos > Thecollection.Count then
Borneto := Thecollection.Count;
else
Borneto := Topos;
end if;
if Frompos < Thecollection.Cells'First then
Bornefrom := Thecollection.Cells'First;
else
Bornefrom := Frompos;
end if;
for I in Bornefrom .. Borneto loop
Add (Result, Get (Thecollection, I));
end loop;
return Result;
end Get;
procedure Forall (Thecollection : Collection.Object) is
begin
for I in 1 .. Thecollection.Count loop
Action (Get (Thecollection, I));
end loop;
end Forall;
procedure Sort (Thecollection : in out Collection.Object) is
Repere : Integer range Thecollection.Cells'First - 1 ..
Thecollection.Cells'Last;
Nombre : Expertsystem.Reference;
begin
for I in Thecollection.Cells'First + 1 .. Thecollection.Count - 1 loop
Nombre := Thecollection.Cells (I);
Repere := I - 1;
while (Repere /= Thecollection.Cells'First - 1) and then
(Nombre < Thecollection.Cells (Repere)) loop
Thecollection.Cells (Repere + 1).Idclass :=
Thecollection.Cells (Repere).Idclass;
Repere := Repere - 1;
end loop;
Thecollection.Cells (Repere + 1) := Nombre;
end loop;
end Sort;
package body Iterator is
function Open (Thecollection : Collection.Object) return Iter is
begin
if Thecollection.Count = 0 then
return 0;
else
return 1;
end if;
end Open;
function Get (Thecollection : Collection.Object; I : Iter)
return Expertsystem.Reference is
Idx : Integer;
begin
Idx := Integer (I);
if Idx > Thecollection.Count then
raise Illegalaccess;
end if;
return Thecollection.Cells (Idx);
exception
when Constraint_Error =>
raise Illegalaccess;
end Get;
function Next (Thecollection : Collection.Object; I : Iter)
return Iter is
Idx : Integer;
begin
Idx := Integer (I) + 1;
if Idx > Thecollection.Count then
return 0;
else
return Iter (Idx);
end if;
exception
when Constraint_Error =>
raise Illegalaccess;
end Next;
function Atend (Thecollection : Collection.Object; I : Iter)
return Boolean is
begin
return I = 0;
end Atend;
end Iterator;
end Collection;
nblk1=12
nid=0
hdr6=24
[0x00] rec0=1c rec1=00 rec2=01 rec3=00a
[0x01] rec0=1d rec1=00 rec2=02 rec3=006
[0x02] rec0=1e rec1=00 rec2=03 rec3=026
[0x03] rec0=22 rec1=00 rec2=04 rec3=01c
[0x04] rec0=18 rec1=00 rec2=05 rec3=01e
[0x05] rec0=19 rec1=00 rec2=06 rec3=002
[0x06] rec0=16 rec1=00 rec2=07 rec3=010
[0x07] rec0=1d rec1=00 rec2=08 rec3=032
[0x08] rec0=17 rec1=00 rec2=09 rec3=02c
[0x09] rec0=1b rec1=00 rec2=0a rec3=024
[0x0a] rec0=1a rec1=00 rec2=0b rec3=002
[0x0b] rec0=19 rec1=00 rec2=0c rec3=016
[0x0c] rec0=19 rec1=00 rec2=0d rec3=04e
[0x0d] rec0=22 rec1=00 rec2=0e rec3=006
[0x0e] rec0=1e rec1=00 rec2=0f rec3=01c
[0x0f] rec0=1b rec1=00 rec2=10 rec3=068
[0x10] rec0=1e rec1=00 rec2=11 rec3=016
[0x11] rec0=1c rec1=00 rec2=12 rec3=000
tail 0x21509b2d2821a489f435d 0x42a00088462060003