|
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: ┃ B T ┃
Length: 8640 (0x21c0)
Types: TextFile
Names: »B«
└─⟦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 Condition;
with Constant_String;
with Text_Io;
use Condition;
package body Fact is
Max_Frame_Count : constant := 200;
Last_Frame : Name := 0;
type Frames is array (Name range <>) of Frame;
Working_Memory : Frames (1 .. Max_Frame_Count) := (others => Null_Frame);
-------------------------------------------------------------------------
function Image (Of_Class : Class_Name) return String
renames Constant_String.Image;
function "=" (Left, Right : Class_Name) return Boolean
renames Constant_String."=";
-------------------------------------------------------------------------
function Empty_Collection return Collection is
begin
return (1 .. 0 => Null_Name);
end Empty_Collection;
function Match (The_Fact_Class, The_Filter_Class : Class_Name)
return Boolean is
Result : Boolean;
begin
Result := The_Fact_Class /= Null_Class_Name and then
The_Fact_Class = The_Filter_Class;
return Result;
end Match;
function Match (The_Slots : Slots; Against : Patterns) return Boolean is
begin
for I in The_Slots'Range loop
if not Match (The_Slots (I), Against (I)) then
return False;
end if;
end loop;
return True;
end Match;
-------------------------------------------------------------------------
function Retrieve (Filter : Queries) return Collection is
Result : Collection (Filter'Range);
Wm : Frames renames Working_Memory;
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 I in Wm'First .. Last_Frame loop
if Match (Wm (I).Class, Filter_Class) and then
Match (Wm (I).Value, Filter (Index).Value) then
if Recursive_Search (Index + 1) then
Result (Index) := I;
return True;
end if;
end if;
end loop;
when Check_No =>
for I in Wm'First .. Last_Frame loop
if Match (Wm (I).Class, Filter_Class) and then
Match (Wm (I).Value, Filter (Index).Value) then
return False;
end if;
end loop;
if Recursive_Search (Index + 1) then
Result (Index) := Null_Name;
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 Add (The_Fact : Frame) is
begin
for I in Working_Memory'Range loop
if Working_Memory (I) = Null_Frame then
Working_Memory (I) := The_Fact;
if I > Last_Frame then
Last_Frame := I;
end if;
return;
end if;
end loop;
raise Overflow;
end Add;
procedure Delete (The_Fact : Name) is
begin
Working_Memory (The_Fact) := Null_Frame;
if Last_Frame = The_Fact then
Last_Frame := Last_Frame - 1;
for I in reverse 1 .. Last_Frame loop
exit when Working_Memory (I) /= Null_Frame;
Last_Frame := I;
end loop;
end if;
end Delete;
procedure Change (The_Fact : Name; Value : Frame) is
begin
Working_Memory (The_Fact) := Value;
end Change;
procedure Change (The_Fact : Name;
The_Slot : Slot_Names;
To_Value : Integer) is
begin
Working_Memory (The_Fact).Value (The_Slot) := To_Value;
end Change;
function Get (The_Fact : Name) return Frame is
begin
return Working_Memory (The_Fact);
end Get;
function Get (The_Fact : Name; Slot : Slot_Names) return Integer is
begin
return Working_Memory (The_Fact).Value (Slot);
end Get;
-------------------------------------------------------------------------
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);
Put (The_Condition => 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_Slots : Slots;
Where : Output_Stream.Object :=
Output_Stream.Standard_Output) is
First : Boolean := True;
use Output_Stream;
begin
for I in The_Slots'Range loop
if not First then
Put (", ", Where);
if I mod 2 /= 0 then
New_Line (Where);
end if;
else
First := False;
end if;
Put ("Slot" & Slot_Names'Image (I) & " =>", Where);
Put (Integer'Image (The_Slots (I)), Where);
end loop;
end Put;
procedure Put (The_Fact : Name; Where : Output_Stream.Object) is
The_Object : Frame;
use Output_Stream;
begin
if The_Fact /= Null_Name then
The_Object := Working_Memory (The_Fact);
if The_Object /= Null_Frame then
Put_Line (Image (The_Object.Class) & "'(", Where);
Indent_Right (Where);
Put (The_Slots => The_Object.Value, Where => Where);
Indent_Left (Where);
Put_Line (")", Where);
end if;
else
Put ("No name", Where);
end if;
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
The_Object : Frame;
use Output_Stream;
begin
Put_Line ("Working_Memory'(", Where);
Indent_Right (Where);
for Name in Working_Memory'Range loop
The_Object := Working_Memory (Name);
if The_Object /= Null_Frame then
Put (Name, Where);
end if;
end loop;
Indent_Left (Where);
Put_Line (")", Where);
end Put;
end Fact;