DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ C T

⟦c213e01b5⟧ TextFile

    Length: 13990 (0x36a6)
    Types: TextFile
    Names: »COLLECTION_ADA«

Derivation

└─⟦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⟧ 

TextFile

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;