DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

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 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦9ec2aa9a3⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Decision_System_2, package body Fruit_Frames, package body Fruit_Rule_Bundle, package body Fruit_Working_Memory, seg_04bae2

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

with Output_Stream;
with Visual_System_2;
with Slot;
with Generic_Kbs;
with Default_User_Operators;


package body Decision_System_2 is

    ----------------------------------------------------------------------------
    package Fruit_Kbs is
        type Class_Names  is (Marker, Nothing);  
        type Rule_Bundles is (Decision_Rule_Bundle);

        package Kbs is new Generic_Kbs
                              (Max_Slots => 60,
                               Max_Condition_Elements_By_Rule => 20,
                               Max_Rules => 10,
                               Class_Names => Class_Names,
                               Null_Class_Name => Class_Names'Last,
                               User_Defined_Expression_Operators =>
                                  Default_User_Operators.Expression_Operators,
                               User_Defined_Unary_Evaluate =>
                                  Default_User_Operators.Unary_Evaluate,
                               User_Defined_Binary_Evaluate =>
                                  Default_User_Operators.Binary_Evaluate,
                               User_Defined_Predicate_Operators =>
                                  Default_User_Operators.Predicate_Operators,
                               User_Defined_Unary_Match =>
                                  Default_User_Operators.Unary_Match,
                               User_Defined_Binary_Match =>
                                  Default_User_Operators.Binary_Match,
                               Rule_Bundles => Rule_Bundles);
    end Fruit_Kbs;

    ----------------------------------------------------------------------------
    package Fruit_Frames is
        use Fruit_Kbs;
        use Fruit_Kbs.Kbs;
        use Slot;
        type Names is (Model_Marker, On_Table_Marker, Selected_Block_Marker,
                       Top_Block_Marker, Top_Copied_Model_Marker);

        package Names_Facilities is new Enumeration_Facilities (Names);

        Model_Marker_Name            : constant Object :=
           Names_Facilities.Value (Model_Marker);
        On_Table_Marker_Name         : constant Object :=
           Names_Facilities.Value (On_Table_Marker);
        Selected_Block_Marker_Name   : constant Object :=
           Names_Facilities.Value (Selected_Block_Marker);
        Top_Block_Marker_Name        : constant Object :=
           Names_Facilities.Value (Top_Block_Marker);
        Top_Copied_Model_Marker_Name : constant Object :=
           Names_Facilities.Value (Top_Copied_Model_Marker);

        type Marker_Slots is (Name);

        package Markers is
           new Fact_Base.Generic_Class (Class_Name => Marker,
                                        Class_Size => 60,
                                        Slot_Names => Marker_Slots);

        procedure Put (The_Fact : Fact_Name; Where : Output_Stream.Object);
    end Fruit_Frames;  
    package body Fruit_Frames is separate;

    ----------------------------------------------------------------------------
    package Fruit_Working_Memory is
        use Fruit_Kbs;

        procedure Put_All is
           new Kbs.Fact_Base.Working_Memory.Generic_Put (Fruit_Frames.Put);

        procedure Default_Put;

        procedure Load_Initial;

    end Fruit_Working_Memory;
    package body Fruit_Working_Memory is separate;

    ----------------------------------------------------------------------------
    package Fruit_Rule_Bundle is
        use Fruit_Kbs.Kbs;

        procedure Do_Action (For_Rule : Rule_Id; On_Facts : Fact_Collection);

    end Fruit_Rule_Bundle;
    package body Fruit_Rule_Bundle is separate;

    ----------------------------------------------------------------------------



    procedure Resolve_Problem is

        use Fruit_Kbs.Kbs;  
        use Output_Stream;
        use Fruit_Working_Memory;

        Inference_Had_Succeded : Boolean := True;


        function Fruit_Infere is
           new Rule_Base.One_Inference_With_Conflict_Set
                  (Retrieve  => Retrieve,
                   Do_Action => Fruit_Rule_Bundle.Do_Action);

    begin
        New_Line (Standard_Output);
        Load_Initial;

        while Inference_Had_Succeded loop

            Put_Line ("THE FACT BASE IS NOW :", Standard_Output);
            Put_All (Output_Stream.Standard_Output);
            New_Line (Standard_Output);
            New_Line (Standard_Output);

            Inference_Had_Succeded := Fruit_Infere;
        end loop;
    end Resolve_Problem;


end Decision_System_2;

    nblk1=7
    nid=7
    hdr6=c
        [0x00] rec0=1a rec1=00 rec2=01 rec3=00c
        [0x01] rec0=00 rec1=00 rec2=06 rec3=008
        [0x02] rec0=13 rec1=00 rec2=02 rec3=056
        [0x03] rec0=16 rec1=00 rec2=04 rec3=028
        [0x04] rec0=23 rec1=00 rec2=03 rec3=02e
        [0x05] rec0=19 rec1=00 rec2=05 rec3=000
        [0x06] rec0=04 rec1=00 rec2=03 rec3=000
    tail 0x21750c8c086844a369607 0x42a00088462063c03
Free Block Chain:
  0x7: 0000  00 00 01 06 80 1b 69 74 69 65 73 2e 56 61 6c 75  ┆      ities.Valu┆