|
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: 30009 (0x7539)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦921f7c521⟧
└─⟦this⟧
with text_io;
package expertSystem is
type reference is private;
nullReference : constant expertSystem.reference;
subtype className is string(1..10);
subtype objectName is string(1..10);
subtype ruleName is string(1..15);
subtype contextName is string(1..10);
subtype strategyName is string(1..5);
subtype ruleId is natural range 0..30;
subtype contextId is natural range 0.. 8;
type strategy is (LEX, MEA, LRU, FIRST);
subtype restrict_strategy is strategy range LRU..FIRST;
classSize : constant positive := 200 ;
ANY : constant := 0;
procedure put ( anInteger : integer);
procedure put ( aChar : character) renames text_io.put;
procedure get ( aChar : out character) renames text_io.get;
procedure put ( aString : string) renames text_io.put;
procedure put_line( aString : string) renames text_io.put_line;
package collection is
type object(size : positive := 20) is private;
function defaultName(aRef : expertSystem.reference) return objectName;
generic
with function predicate(aRef : Reference) return boolean;
function restrict (theCollection : collection.object;
quantity : natural := ANY)
return collection.object;
generic
with function predicate(aRef : expertSystem.reference) return boolean;
function findOne (theCollection : collection.object ) return expertSystem.reference;
generic
with function predicate(aRef : expertSystem.reference) return boolean;
function notExist (theCollection : collection.object ) return boolean;
generic
with function predicate(aRef : expertSystem.reference) return boolean;
function exist (theCollection : collection.object ) return boolean;
generic
with function predicate( theBest : expertSystem.reference ;
anyOther : expertSystem.reference) return boolean;
function theMost( theCollection : collection.object) return expertSystem.reference;
function cardinality( theCollection : collection.object) return natural;
function isNull ( theCollection : collection.object) return boolean;
function isNotNull ( theCollection : collection.object) return boolean;
function isNull (aRef : expertSystem.reference) return boolean;
function isNotNull (aRef : expertSystem.reference) return boolean;
procedure add (theCollection : in out collection.object;
aRef : in expertSystem.reference);
procedure remove(theCollection : in out collection.object;
aRef : in expertSystem.reference);
procedure upDate(theCollection : in out collection.object;
aRef : in expertSystem.reference);
procedure upDate(theCollection : in out collection.object;
aRef : in expertSystem.reference;
withDate : in long_integer);
procedure upDateAll(theCollection : in out collection.object);
procedure clear (theCollection : in out collection.object);
function union( collection1 : collection.object ;
collection2 : collection.object)
return collection.object;
function "+" ( collection1 : collection.object ;
collection2 : collection.object)
return collection.object renames union;
function intersection(collection1 : collection.object ;
collection2 : collection.object)
return collection.object;
function "*"(collection1 : collection.object ;
collection2 : collection.object)
return collection.object renames intersection ;
function difference(collection1 : collection.object ;
collection2 : collection.object)
return collection.object;
function "-"(collection1 : collection.object ;
collection2 : collection.object)
return collection.object renames difference;
function member(theCollection : collection.object;
aRef : expertSystem.reference)
return boolean;
function isInclude(collection1 : collection.object ;
collection2 : collection.object)
return boolean;
function "<" (collection1 : collection.object ;
collection2 : collection.object)
return boolean renames isInclude;
function "<=" (collection1 : collection.object ;
collection2 : collection.object)
return boolean renames isInclude;
function ">" (collection1 : collection.object ;
collection2 : collection.object)
return boolean;
function ">=" (collection1 : collection.object ;
collection2 : collection.object)
return boolean renames ">";
function asObject(aRef : expertSystem.reference) return collection.object;
function get (theCollection : collection.object;
number : positive :=1)
return expertSystem.reference;
function get(theCollection : collection.object;
fromPos : positive :=1;
toPos : positive)
return collection.object;
function first(theCollection : collection.object) return expertSystem.reference;
function rest (theCollection : collection.object) return collection.object;
generic
with procedure action(aRef : expertSystem.reference);
procedure forAll( theCollection : collection.object);
generic
with function "<"(refOne, refTwo : expertSystem.reference) return boolean;
procedure sort( theCollection : in out collection.object);
badClass : exception;
package iterator is
illegalAccess : exception;
type iter is private;
function open (theCollection : collection.object) return iter;
function get (theCollection : collection.object; i : iter) return expertSystem.reference;
function next (theCollection : collection.object; i : iter) return iter;
function atEnd(theCollection : collection.object; i : iter) return boolean;
private
type iter is range natural'FIRST .. natural'LAST;
end iterator;
private
type CollArray is array(integer range <>) of expertSystem.reference;
type object(size : positive := 20) is record
cells : CollArray (1..size);
count : natural := 0;
unity : positive := 1;
end record;
end collection;
package classIdentity is
function unknownClassName ( aRef : expertSystem.reference) return className;
function unknownObjectName( aRef : expertSystem.reference) return objectName;
end classIdentity;
generic
type element is private;
surname : in className := "NONAME ";
taille : in positive := classSize;
with function refName(aRef : expertSystem.reference) return objectName is collection.defaultName;
package classBehavior is
function allocate(initValue : element) return expertSystem.reference;
procedure allocate(initValue : element);
procedure dispose (aRef : expertSystem.reference);
procedure clear;
procedure mask (aRef : expertSystem.reference);
procedure maskAll;
procedure unmask (aRef : expertSystem.reference);
procedure unmaskAll;
function instances return collection.object;
function allInstances return collection.object;
function cardinality return natural;
function name return className;
function name(aRef : expertSystem.reference) return objectName;
function get(aRef : expertSystem.reference) return element;
procedure set(aRef : expertSystem.reference;
withValue : element);
badClass, badReference, classFull : exception ;
end classBehavior;
package tuple is
type object(size : positive := 20) is private;
function cardinality(theTuple : tuple.object) return natural;
function isNull (theTuple : tuple.object) return boolean;
function isNotNull (theTuple : tuple.object) return boolean;
generic
with procedure action(aRef : expertSystem.reference);
procedure forAll(theTuple : tuple.object);
function first (theTuple : tuple.object) return expertSystem.reference;
function second (theTuple : tuple.object) return expertSystem.reference;
function third (theTuple : tuple.object) return expertSystem.reference;
function fourth (theTuple : tuple.object) return expertSystem.reference;
function fifth (theTuple : tuple.object) return expertSystem.reference;
function sixth (theTuple : tuple.object) return expertSystem.reference;
function seventh(theTuple : tuple.object) return expertSystem.reference;
function eighth (theTuple : tuple.object) return expertSystem.reference;
function ninth (theTuple : tuple.object) return expertSystem.reference;
function tenth (theTuple : tuple.object) return expertSystem.reference;
function get(theTuple : tuple.object;
item : positive := 1) return expertSystem.reference;
procedure add(theTuple : in out tuple.object;
aRef : expertSystem.reference);
procedure merge(theTuple : in out tuple.object;
r1 : expertSystem.reference :=nullReference;
r2 : expertSystem.reference :=nullReference;
r3 : expertSystem.reference :=nullReference;
r4 : expertSystem.reference :=nullReference;
r5 : expertSystem.reference :=nullReference;
r6 : expertSystem.reference :=nullReference;
r7 : expertSystem.reference :=nullReference;
r8 : expertSystem.reference :=nullReference;
r9 : expertSystem.reference :=nullReference;
r10 : expertSystem.reference :=nullReference);
function asObject(aRef : expertSystem.reference) return tuple.object;
generic
with function "<"(refOne, refTwo : expertSystem.reference) return boolean;
procedure sort( theTuple : in out tuple.object);
private
type CollArray is array(integer range <>) of expertSystem.reference;
type object(size : positive := 20) is record
cells : CollArray (1..size);
count : natural := 0;
unity : positive := 1;
end record;
end tuple;
package tupleCollection is
type object(size : positive := 20) is private;
function cardinality(theTupleCollection : tupleCollection.object) return natural;
function isNull (theTupleCollection : tupleCollection.object) return boolean;
function isNotNull (theTupleCollection : tupleCollection.object) return boolean;
generic
with function match(r1 : expertSystem.reference) return boolean;
function join1(c1 : collection.object; quantity : natural := 1)
return tupleCollection.object;
generic
with function match(r1, r2 : expertSystem.reference) return boolean;
function join2(c1, c2 : collection.object; quantity : natural := 1)
return tupleCollection.object;
generic
with function match(r1, r2, r3 : expertSystem.reference) return boolean;
function join3(c1, c2, c3 : collection.object; quantity : natural := 1)
return tupleCollection.object;
generic
with function match(r1, r2, r3, r4 : expertSystem.reference) return boolean;
function join4(c1, c2, c3, c4 : collection.object; quantity : natural := 1)
return tupleCollection.object;
generic
with function match(r1, r2, r3, r4, r5 : expertSystem.reference) return boolean;
function join5(c1, c2, c3, c4, c5 : collection.object; quantity : natural := 1)
return tupleCollection.object;
generic
with function match(r1, r2, r3, r4, r5, r6 : expertSystem.reference) return boolean;
function join6(c1, c2, c3, c4, c5, c6 : collection.object; quantity : natural := 1)
return tupleCollection.object;
generic
with function match(r1, r2, r3, r4, r5, r6, r7 : expertSystem.reference)
return boolean;
function join7(c1, c2, c3, c4, c5, c6, c7 : collection.object;
quantity : natural := 1)
return tupleCollection.object;
generic
with function match(r1, r2, r3, r4, r5, r6, r7, r8 : expertSystem.reference)
return boolean;
function join8(c1, c2, c3, c4, c5, c6, c7, c8 : collection.object;
quantity : natural := 1)
return tupleCollection.object;
generic
with function match(r1, r2, r3, r4, r5, r6, r7, r8, r9 : expertSystem.reference)
return boolean;
function join9(c1, c2, c3, c4, c5, c6, c7, c8, c9 : collection.object;
quantity : natural := 1)
return tupleCollection.object;
generic
with function match(r1, r2, r3, r4, r5, r6, r7, r8, r9, r10: expertSystem.reference)
return boolean;
function join10(c1, c2, c3, c4, c5, c6, c7, c8, c9, c10 :
collection.object; quantity : natural := 1)
return tupleCollection.object;
generic
with function predicate(theBest : tuple.object ;
anyOther : tuple.object)
return boolean;
function theMost( theTupleCollection : tupleCollection.object)
return tuple.object;
generic
with function predicate(t : tuple.object) return boolean;
function restrict(theTupleCollection : tupleCollection.object;
quantity : natural :=ANY)
return tupleCollection.object;
generic
with function predicate(t : tuple.object) return boolean;
function findOne(theTupleCollection : tupleCollection.object) return tuple.object;
function get(theTupleCollection : tupleCollection.object;
number : positive := 1)
return tuple.object;
function first(theTupleCollection : tupleCollection.object)
return tuple.object;
function get (theTupleCollection : tupleCollection.object;
fromPos : positive :=1;
toPos : positive)
return tupleCollection.object;
generic
with procedure action(aTuple : tuple.object);
procedure forAll(theTupleCollection : tupleCollection.object);
package iterator is
illegalAccess: exception;
type iter is private;
function open (theTupleCollection : tupleCollection.object) return iter;
function get (theTupleCollection : tupleCollection.object; i : iter) return tuple.object;
function next (theTupleCollection : tupleCollection.object; i : iter) return iter;
function atEnd(theTupleCollection : tupleCollection.object; i : iter) return boolean;
private
type iter is range natural'FIRST .. natural'LAST;
end iterator;
private
type CollArray is array(integer range <>) of expertSystem.reference;
type object(size : positive := 20) is record
cells : CollArray (1..size);
count : natural := 0;
unity : positive := 1;
end record;
end tupleCollection;
package ruleManager is
function isMasked (context : contextName; rule : ruleId) return boolean;
function isMasked (context : contextId ; rule : ruleId) return boolean;
procedure mask (context : contextName; rule : ruleId);
procedure unmask (context : contextName; rule : ruleId);
badContext, badRule : exception;
end ruleManager;
package debugger is
type debuggingMode is ( text, graphic);
type itemDebugged is ( contextEntered,
strategyUsed,
conflictSetStarted,
conflictSetFinished,
conditionEvalued,
choosedRule,
choosedAction,
ruleFacts,
actionFact,
newStep,
failed,
completly);
type itemSet is array(positive range <>) of itemDebugged;
procedure sendContextEntered( name : contextName ;
number : contextId);
procedure sendStrategyUsed( name : strategyName);
procedure sendConflictSetStarted;
procedure sendConflictSetFinished;
procedure sendConditionEvalued( name : ruleName;
number : natural;
result : boolean;
facts : tupleCollection.object);
procedure sendChoosedRule( number : natural;
fact : tuple.object);
procedure sendChoosedAction( name : ruleName;
number : natural;
fact : tuple.object);
procedure sendNewStep;
procedure sendFailed;
function isDebugged(what : itemDebugged) return boolean;
procedure setDebugOn( item : itemDebugged);
procedure setDebugOn( item : itemSet);
procedure setDebugOff( item : itemDebugged);
procedure setDebugOff( item : itemSet);
procedure resetDebug(mode : debuggingMode);
procedure refreshDebug;
procedure sendRulesNames( contextNumber : contextId;
ctxName : contextName;
name_1 ,name_2 ,name_3 ,name_4 ,name_5 ,name_6 ,name_7,
name_8 ,name_9 ,name_10,name_11,name_12,name_13,name_14,
name_15,name_16,name_17,name_18,name_19,name_20,name_21,
name_22,name_23,name_24,name_25,name_26,name_27,name_28,
name_29,name_30 : ruleName);
end debugger;
package nothing is
procedure to_do;
function to_give return tupleCollection.object;
procedure to_do(t : tuple.object);
end nothing;
generic
context_name : in contextName := " UNNAMED ";
resolution : in strategy := LEX;
name_1 : in ruleName := "Rule number 01";
with function condition_1 return tupleCollection.object;
with procedure action_1(t : tuple.object);
name_2 : in ruleName := "Rule number 02";
with function condition_2 return tupleCollection.object is nothing.to_give;
with procedure action_2(t : tuple.object) is nothing.to_do;
name_3 : in ruleName := "Rule number 03";
with function condition_3 return tupleCollection.object is nothing.to_give;
with procedure action_3(t : tuple.object) is nothing.to_do;
name_4 : in ruleName := "Rule number 04";
with function condition_4 return tupleCollection.object is nothing.to_give;
with procedure action_4(t : tuple.object) is nothing.to_do;
name_5 : in ruleName := "Rule number 05";
with function condition_5 return tupleCollection.object is nothing.to_give;
with procedure action_5(t : tuple.object) is nothing.to_do;
name_6 : in ruleName := "Rule number 06";
with function condition_6 return tupleCollection.object is nothing.to_give;
with procedure action_6(t : tuple.object) is nothing.to_do;
name_7 : in ruleName := "Rule number 07";
with function condition_7 return tupleCollection.object is nothing.to_give;
with procedure action_7(t : tuple.object) is nothing.to_do;
name_8 : in ruleName := "Rule number 08";
with function condition_8 return tupleCollection.object is nothing.to_give;
with procedure action_8(t : tuple.object) is nothing.to_do;
name_9 : in ruleName := "Rule number 09";
with function condition_9 return tupleCollection.object is nothing.to_give;
with procedure action_9(t : tuple.object) is nothing.to_do;
name_10 : in ruleName := "Rule number 10";
with function condition_10 return tupleCollection.object is nothing.to_give;
with procedure action_10(t : tuple.object) is nothing.to_do;
name_11 : in ruleName := "Rule number 11";
with function condition_11 return tupleCollection.object is nothing.to_give;
with procedure action_11(t : tuple.object) is nothing.to_do;
name_12 : in ruleName := "Rule number 12";
with function condition_12 return tupleCollection.object is nothing.to_give;
with procedure action_12(t : tuple.object) is nothing.to_do;
name_13 : in ruleName := "Rule number 13";
with function condition_13 return tupleCollection.object is nothing.to_give;
with procedure action_13(t : tuple.object) is nothing.to_do;
name_14 : in ruleName := "Rule number 14";
with function condition_14 return tupleCollection.object is nothing.to_give;
with procedure action_14(t : tuple.object) is nothing.to_do;
name_15 : in ruleName := "Rule number 15";
with function condition_15 return tupleCollection.object is nothing.to_give;
with procedure action_15(t : tuple.object) is nothing.to_do;
name_16 : in ruleName := "Rule number 16";
with function condition_16 return tupleCollection.object is nothing.to_give;
with procedure action_16(t : tuple.object) is nothing.to_do;
name_17 : in ruleName := "Rule number 17";
with function condition_17 return tupleCollection.object is nothing.to_give;
with procedure action_17(t : tuple.object) is nothing.to_do;
name_18 : in ruleName := "Rule number 18";
with function condition_18 return tupleCollection.object is nothing.to_give;
with procedure action_18(t : tuple.object) is nothing.to_do;
name_19 : in ruleName := "Rule number 19";
with function condition_19 return tupleCollection.object is nothing.to_give;
with procedure action_19(t : tuple.object) is nothing.to_do;
name_20 : in ruleName := "Rule number 20";
with function condition_20 return tupleCollection.object is nothing.to_give;
with procedure action_20(t : tuple.object) is nothing.to_do;
name_21 : in ruleName := "Rule number 21";
with function condition_21 return tupleCollection.object is nothing.to_give;
with procedure action_21(t : tuple.object) is nothing.to_do;
name_22 : in ruleName := "Rule number 22";
with function condition_22 return tupleCollection.object is nothing.to_give;
with procedure action_22(t : tuple.object) is nothing.to_do;
name_23 : in ruleName := "Rule number 23";
with function condition_23 return tupleCollection.object is nothing.to_give;
with procedure action_23(t : tuple.object) is nothing.to_do;
name_24 : in ruleName := "Rule number 24";
with function condition_24 return tupleCollection.object is nothing.to_give;
with procedure action_24(t : tuple.object) is nothing.to_do;
name_25 : in ruleName := "Rule number 25";
with function condition_25 return tupleCollection.object is nothing.to_give;
with procedure action_25(t : tuple.object) is nothing.to_do;
name_26 : in ruleName := "Rule number 26";
with function condition_26 return tupleCollection.object is nothing.to_give;
with procedure action_26(t : tuple.object) is nothing.to_do;
name_27 : in ruleName := "Rule number 27";
with function condition_27 return tupleCollection.object is nothing.to_give;
with procedure action_27(t : tuple.object) is nothing.to_do;
name_28 : in ruleName := "Rule number 28";
with function condition_28 return tupleCollection.object is nothing.to_give;
with procedure action_28(t : tuple.object) is nothing.to_do;
name_29 : in ruleName := "Rule number 29";
with function condition_29 return tupleCollection.object is nothing.to_give;
with procedure action_29(t : tuple.object) is nothing.to_do;
name_30 : in ruleName := "Rule number 30";
with function condition_30 return tupleCollection.object is nothing.to_give;
with procedure action_30(t : tuple.object) is nothing.to_do;
used_rules : positive :=30;
package engine is
function inference( step : natural:=1) return boolean;
end engine;
generic
context_name : in contextName := " UNNAMED ";
resolution : in restrict_strategy := FIRST;
name_1 : in ruleName := "Rule number 01";
with function condition_1 return boolean;
with procedure action_1;
name_2 : in ruleName := "Rule number 02";
with function condition_2 return boolean is FALSE;
with procedure action_2 is nothing.to_do;
name_3 : in ruleName := "Rule number 03";
with function condition_3 return boolean is FALSE;
with procedure action_3 is nothing.to_do;
name_4 : in ruleName := "Rule number 04";
with function condition_4 return boolean is FALSE;
with procedure action_4 is nothing.to_do;
name_5 : in ruleName := "Rule number 05";
with function condition_5 return boolean is FALSE;
with procedure action_5 is nothing.to_do;
name_6 : in ruleName := "Rule number 06";
with function condition_6 return boolean is FALSE;
with procedure action_6 is nothing.to_do;
name_7 : in ruleName := "Rule number 07";
with function condition_7 return boolean is FALSE;
with procedure action_7 is nothing.to_do;
name_8 : in ruleName := "Rule number 08";
with function condition_8 return boolean is FALSE;
with procedure action_8 is nothing.to_do;
name_9 : in ruleName := "Rule number 09";
with function condition_9 return boolean is FALSE;
with procedure action_9 is nothing.to_do;
name_10 : in ruleName := "Rule number 10";
with function condition_10 return boolean is FALSE;
with procedure action_10 is nothing.to_do;
name_11 : in ruleName := "Rule number 11";
with function condition_11 return boolean is FALSE;
with procedure action_11 is nothing.to_do;
name_12 : in ruleName := "Rule number 12";
with function condition_12 return boolean is FALSE;
with procedure action_12 is nothing.to_do;
name_13 : in ruleName := "Rule number 13";
with function condition_13 return boolean is FALSE;
with procedure action_13 is nothing.to_do;
name_14 : in ruleName := "Rule number 14";
with function condition_14 return boolean is FALSE;
with procedure action_14 is nothing.to_do;
name_15 : in ruleName := "Rule number 15";
with function condition_15 return boolean is FALSE;
with procedure action_15 is nothing.to_do;
name_16 : in ruleName := "Rule number 16";
with function condition_16 return boolean is FALSE;
with procedure action_16 is nothing.to_do;
name_17 : in ruleName := "Rule number 17";
with function condition_17 return boolean is FALSE;
with procedure action_17 is nothing.to_do;
name_18 : in ruleName := "Rule number 18";
with function condition_18 return boolean is FALSE;
with procedure action_18 is nothing.to_do;
name_19 : in ruleName := "Rule number 19";
with function condition_19 return boolean is FALSE;
with procedure action_19 is nothing.to_do;
name_20 : in ruleName := "Rule number 20";
with function condition_20 return boolean is FALSE;
with procedure action_20 is nothing.to_do;
name_21 : in ruleName := "Rule number 21";
with function condition_21 return boolean is FALSE;
with procedure action_21 is nothing.to_do;
name_22 : in ruleName := "Rule number 22";
with function condition_22 return boolean is FALSE;
with procedure action_22 is nothing.to_do;
name_23 : in ruleName := "Rule number 23";
with function condition_23 return boolean is FALSE;
with procedure action_23 is nothing.to_do;
name_24 : in ruleName := "Rule number 24";
with function condition_24 return boolean is FALSE;
with procedure action_24 is nothing.to_do;
name_25 : in ruleName := "Rule number 25";
with function condition_25 return boolean is FALSE;
with procedure action_25 is nothing.to_do;
name_26 : in ruleName := "Rule number 26";
with function condition_26 return boolean is FALSE;
with procedure action_26 is nothing.to_do;
name_27 : in ruleName := "Rule number 27";
with function condition_27 return boolean is FALSE;
with procedure action_27 is nothing.to_do;
name_28 : in ruleName := "Rule number 28";
with function condition_28 return boolean is FALSE;
with procedure action_28 is nothing.to_do;
name_29 : in ruleName := "Rule number 29";
with function condition_29 return boolean is FALSE;
with procedure action_29 is nothing.to_do;
name_30 : in ruleName := "Rule number 30";
with function condition_30 return boolean is FALSE;
with procedure action_30 is nothing.to_do;
used_rules : positive := 30;
package motor is
function inference(step : natural := 1) return boolean;
end motor;
package terminal is
procedure atXY(x : natural ; y : natural) ;
procedure clear;
end terminal;
private
subtype idO is natural;
subtype idC is natural;
type reference is record
idObject : idO;
idClass : idC;
date : long_integer;
end record;
nullReference : constant expertSystem.reference := (1,0,0);
end expertSystem;