|
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 - metrics - download
Length: 17408 (0x4400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, procedure Test, seg_029567
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Condition;
with Fact;
with Text_Io;
use Condition;
use Fact;
procedure Test is
generic
Name : String := "no name";
Premiss : Join_Descriptor;
with procedure Action (On : Fact.Collection);
function Rule return Boolean;
function Rule return Boolean is
Answer : constant Fact.Collection := Fact.Retrieve (Filter => Premiss);
begin
if Answer /= Empty_Collection then
Action (On => Answer);
return True;
else
-- Text_Io.Put_Line (Name & " not_fired");
return False;
end if;
end Rule;
generic
with function Rule_1 return Boolean is False;
with function Rule_2 return Boolean is False;
with function Rule_3 return Boolean is False;
with function Rule_4 return Boolean is False;
with function Rule_5 return Boolean is False;
procedure Infere;
procedure Infere is
begin
loop
exit when not (Rule_1 or else Rule_2 or else
Rule_3 or else Rule_4 or else Rule_5);
end loop;
end Infere;
----- << rule Print_The_Biggest_Red_Ball >> -----
procedure Print_The_Biggest_Ball_Action (Objects : Fact.Collection) is
The_Ball : Fact.Name renames Objects (1);
begin
Text_Io.Put_Line ("The biggest ball is : ");
Put (The_Ball);
end Print_The_Biggest_Ball_Action;
function Print_The_Biggest_Ball_Rule is
new Rule (Name => "Print_The_Biggest_Ball",
Premiss => ((Find, (Class => Is_Equal (Ball),
Size => Say_It_Is (S),
Colour => Is_Equal (Red),
State => Is_Any)),
(Check_No, (Class => Is_Equal (Ball),
Size => Is_Greater (S),
State | Colour => Is_Any))),
Action => Print_The_Biggest_Ball_Action);
----- << rule dump_the_working_memory >> -----
procedure Dump_The_Working_Memory_Action (Objects : Fact.Collection) is
The_Fact : Fact.Name renames Objects (1);
begin
Put (The_Fact);
Delete (The_Fact);
end Dump_The_Working_Memory_Action;
function Dump_The_Working_Memory_Rule is
new Rule (Name => "Dump_The_Working_Memory",
Premiss => (1 => (Find,
Pattern'(Class => Is_Any,
State | Colour | Size => Is_Any))),
Action => Dump_The_Working_Memory_Action);
----- << rule remove_the_robots >> -----
procedure Remove_The_Robots_Action (Objects : Fact.Collection) is
The_Fact : Fact.Name renames Objects (1);
begin
Put (The_Fact);
Text_Io.Put_Line (" --> has been removed");
Delete (The_Fact);
end Remove_The_Robots_Action;
function Remove_The_Robots_Rule is
new Rule (Name => "Remove_The_Robots",
Premiss => (1 => (Find, (Class => Is_Equal (Robot),
State | Size | Colour => Is_Any))),
Action => Remove_The_Robots_Action);
----- << rule Pair_Ball_And_Boxes_Rule >> -----
procedure Pair_Ball_And_Boxes_Action (The_Pair : Fact.Collection) is
The_Ball : Fact.Name renames The_Pair (1);
The_Box : Fact.Name renames The_Pair (2);
begin
Text_Io.Put_Line ("Ball : ");
Put (The_Ball);
Text_Io.Put_Line ("Paired with box :");
Put (The_Box);
Change (The_Ball, State, To_Value => In_Box);
Change (The_Box, State, To_Value =>Busy);
end Pair_Ball_And_Boxes_Action;
function Pair_Ball_And_Boxes_Rule is
new Rule (Name => "Pair_Ball_And_Boxes",
Premiss => ((Find, (Class => Is_Equal (Ball),
Size => Say_It_Is (S),
Colour => Say_It_Is (C),
State => Is_Equal (On_Heap))),
(Find, (Class => Is_Equal (Box),
Colour => Is_Equal (C),
Size => Say_It_Is (T) and Is_Greater (S),
State => Is_Equal (Free))),
(Check_No, (Class => Is_Equal (Box),
Colour => Is_Equal (C),
Size => Is_Less (T) and Is_Greater (S),
State => Is_Equal (Free)))),
Action => Pair_Ball_And_Boxes_Action);
------------------------------------------------
procedure Play_With_Ball_And_Boxes is
new Infere (Rule_1 => Remove_The_Robots_Rule,
Rule_2 => Pair_Ball_And_Boxes_Rule,
Rule_3 => Print_The_Biggest_Ball_Rule,
Rule_4 => Dump_The_Working_Memory_Rule);
begin
Play_With_Ball_And_Boxes;
end Test;
nblk1=10
nid=9
hdr6=10
[0x00] rec0=24 rec1=00 rec2=01 rec3=006
[0x01] rec0=00 rec1=00 rec2=06 rec3=006
[0x02] rec0=1b rec1=00 rec2=0d rec3=070
[0x03] rec0=1c rec1=00 rec2=10 rec3=00a
[0x04] rec0=1d rec1=00 rec2=0b rec3=056
[0x05] rec0=00 rec1=00 rec2=08 rec3=002
[0x06] rec0=13 rec1=00 rec2=0e rec3=03e
[0x07] rec0=0c rec1=00 rec2=07 rec3=000
[0x08] rec0=20 rec1=00 rec2=08 rec3=006
[0x09] rec0=1e rec1=00 rec2=07 rec3=016
[0x0a] rec0=19 rec1=00 rec2=10 rec3=05e
[0x0b] rec0=01 rec1=00 rec2=0d rec3=066
[0x0c] rec0=16 rec1=00 rec2=06 rec3=054
[0x0d] rec0=0f rec1=00 rec2=0b rec3=000
[0x0e] rec0=07 rec1=00 rec2=06 rec3=001
[0x0f] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21722d0a483cd879b3240 0x42a00088462063c03
Free Block Chain:
0x9: 0000 00 05 00 07 80 04 77 68 65 6e 04 20 20 20 20 20 ┆ when ┆
0x5: 0000 00 02 03 fc 00 1b 20 20 20 20 20 20 20 20 72 65 ┆ re┆
0x2: 0000 00 04 03 fc 80 17 6d 61 67 65 20 28 54 68 65 5f ┆ mage (The_┆
0x4: 0000 00 0a 03 fc 80 0f 20 72 65 74 75 72 6e 20 22 42 ┆ return "B┆
0xa: 0000 00 03 00 5d 80 0b 65 6e 20 52 6f 62 6f 74 20 3d ┆ ] en Robot =┆
0x3: 0000 00 0f 03 fc 80 0e 74 61 74 65 20 3d 3e 20 48 65 ┆ tate => He┆
0xf: 0000 00 0c 00 1e 80 1b 7a 65 20 3d 3e 20 35 30 2c 20 ┆ ze => 50, ┆
0xc: 0000 00 00 00 0b 80 08 20 20 20 20 20 20 20 20 08 65 ┆ e┆