|
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: ┃ C T ┃
Length: 13990 (0x36a6)
Types: TextFile
Names: »COLLECTION_ADA«
└─⟦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 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 ;
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;