|
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: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Fact, package body Generic_Fact_Base, package body Working_Memory, seg_02ccb6
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
package body Generic_Fact_Base is
package Working_Memory is
type Frame (Size : Value_Size := 0) is private;
type Slots is array (Slot_Names range <>) of Integer;
Null_Frame : constant Frame;
function Last return Object; -- objects are from 1 to last
procedure Make_Empty;
function Make (The_Class : Class_Name; The_Slots : Slots) return Frame;
function Get (The_Fact : Object) return Frame;
function Get (The_Fact : Object; Slot : Slot_Names) return Integer;
procedure Add (The_Fact : Frame);
procedure Delete (The_Fact : Object);
procedure Change (The_Fact : Object; Value : Frame);
procedure Change (The_Fact : Object;
The_Slot : Slot_Names;
To_Value : Integer);
function Match (The_Element : Object; Against : Query) return Boolean;
procedure Put (The_Fact : Object; Where : Output_Stream.Object);
procedure Put (Where : Output_Stream.Object); -- The working memory
private
type Frame (Size : Value_Size := 0) is
record
Class : Class_Name;
Value : Slots (1 .. Size);
end record;
Null_Frame : constant Frame :=
(Size => 0, Class => Null_Class_Name, Value => (others => 0));
end Working_Memory;
function Image (Of_Class : Class_Name) return String
renames Constant_String.Image;
function Empty_Collection return Collection is
begin
return (1 .. 0 => Null_Object);
end Empty_Collection;
function Null_Premiss return Queries is
begin
return Queries'(1 .. 0 => Null_Query);
end Null_Premiss;
function Retrieve (Filter : Queries) return Collection is
Result : Collection (Filter'Range);
function Recursive_Search (Index : Positive) return Boolean is
Filter_Class : Class_Name;
begin
if Index > Filter'Last then
return True;
else
Filter_Class := Filter (Index).Class;
case Filter (Index).Kind is
when Find =>
for Element in 1 .. Working_Memory.Last loop
if Working_Memory.Match
(Element, Against => Filter (Index)) then
if Recursive_Search (Index + 1) then
Result (Index) := Element;
return True;
end if;
end if;
end loop;
when Check_No =>
for Element in 1 .. Working_Memory.Last loop
if Working_Memory.Match
(Element, Against => Filter (Index)) then
return False;
end if;
end loop;
if Recursive_Search (Index + 1) then
Result (Index) := Null_Object;
return True;
end if;
end case;
return False;
end if;
end Recursive_Search;
begin
if Filter'Length /= 0 and then Recursive_Search (Filter'First) then
return Result;
else
return Empty_Collection;
end if;
end Retrieve;
-------------------------------------------------------------------------
procedure Make_Empty is
begin
Working_Memory.Make_Empty;
end Make_Empty;
procedure Put (The_Patterns : Patterns;
Where : Output_Stream.Object :=
Output_Stream.Standard_Output) is
First : Boolean := True;
use Output_Stream;
begin
for I in The_Patterns'Range loop
if not First then
Put_Line (", ", Where);
else
First := False;
end if;
Put ("Slot" & Slot_Names'Image (I) & " => ", Where);
Predicate_Put (The_Expression => The_Patterns (I), Where => Where);
end loop;
end Put;
procedure Put (The_Query : Query; Where : Output_Stream.Object) is
use Output_Stream;
begin
case The_Query.Kind is
when Find =>
Put_Line
("Find_" & Image (The_Query.Class) & "_Such_As'(", Where);
when Check_No =>
Put_Line
("Check_No_" & Image (The_Query.Class) & "_Has'(", Where);
end case;
Indent_Right (Where);
Put (The_Patterns => The_Query.Value, Where => Where);
Indent_Left (Where);
Put_Line (")", Where);
end Put;
procedure Put (The_Queries : Queries; Where : Output_Stream.Object) is
use Output_Stream;
begin
Put ("Premiss'(", Where);
Indent_Right (Where);
for I in The_Queries'Range loop
Put (The_Queries (I), Where);
New_Line (Where);
end loop;
Indent_Left (Where);
Put_Line (")", Where);
end Put;
procedure Put (The_Fact : Object; Where : Output_Stream.Object) is
begin
Working_Memory.Put (The_Fact, Where);
end Put;
procedure Put (The_Collection : Collection; Where : Output_Stream.Object) is
use Output_Stream;
begin
Put_Line ("Fact_collection'(", Where);
Indent_Right (Where);
if The_Collection'Length /= 0 then
for I in The_Collection'Range loop
Put (The_Collection (I), Where);
end loop;
end if;
Indent_Left (Where);
New_Line (Where);
Put_Line (")", Where);
end Put;
procedure Put (Where : Output_Stream.Object) is
begin
Working_Memory.Put (Where);
end Put;
package body Working_Memory is separate;
package body Generic_Fact is separate;
end Generic_Fact_Base;
nblk1=8
nid=0
hdr6=10
[0x00] rec0=1d rec1=00 rec2=01 rec3=03c
[0x01] rec0=00 rec1=00 rec2=08 rec3=02e
[0x02] rec0=22 rec1=00 rec2=02 rec3=08a
[0x03] rec0=15 rec1=00 rec2=03 rec3=06e
[0x04] rec0=1e rec1=00 rec2=04 rec3=05a
[0x05] rec0=1c rec1=00 rec2=05 rec3=014
[0x06] rec0=1f rec1=00 rec2=06 rec3=018
[0x07] rec0=0f rec1=00 rec2=07 rec3=001
tail 0x2152542a4840b889416c1 0x42a00088462063c03