DataMuseum.dk

top - download

    Length: 4669 (0x123d)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦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⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦e24fb53b7⟧ 
            └─⟦this⟧ 

TextFile

package body Generic_Conflict_Set is  
    type Node;
    type Access_Node is access Node;

    type Node is  -- a binary search tree
        record
            The_Instance : Instance;  
            Left, Right  : Access_Node;
        end record;

    The_Root      : Access_Node;
    The_Free_List : Access_Node;   -- chained nodes on left link

    function New_Node return Access_Node is  
        Result : Access_Node;
    begin
        if The_Free_List = null then
            return new Node;
        else
            Result        := The_Free_List;
            The_Free_List := Result.Left;
            return Result;
        end if;
    end New_Node;

    procedure Old_Node (The_Node : in out Access_Node) is
    begin
        The_Node.Left := The_Free_List;
        The_Free_List := The_Node;  
        The_Node      := null;
    end Old_Node;

    procedure Clear (The_Tree : in out Access_Node) is
    begin
        if The_Tree /= null then
            Clear (The_Tree.Left);
            Clear (The_Tree.Right);
            Old_Node (The_Tree);
        end if;
    end Clear;

    procedure Clear is
    begin
        Clear (The_Root);
    end Clear;


    procedure Add (To : in out Access_Node; The_Instance : Instance) is
    begin
        if To = null then
            To     := New_Node;  
            To.all := Node'(The_Instance, null, null);
        elsif The_Instance < To.The_Instance then
            Add (To.Left, The_Instance);
        elsif The_Instance /= To.The_Instance then
            Add (To.Right, The_Instance);
        end if;
    end Add;

    procedure Add (The_Instance : Instance) is
    begin
        Add (The_Root, The_Instance);
    end Add;


    procedure Get (From : in out Access_Node; The_Instance : out Instance) is
        -- return most right
        Old_From : Access_Node := From;
    begin
        if From = null then
            raise Underflow;
        elsif From.Right /= null then
            Get (From.Right, The_Instance);
        else
            The_Instance := From.The_Instance;
            From         := From.Left;
            Old_Node (Old_From);
        end if;
    end Get;


    function Get return Instance is
        Result : Instance;
    begin
        Get (From => The_Root, The_Instance => Result);
        return Result;
    end Get;


    procedure Delete (From : in out Access_Node; The_Instance : Instance) is
        Old_From : Access_Node := From;
    begin
        if From /= null then
            if The_Instance < From.The_Instance then
                Delete (From.Left, The_Instance);
            elsif The_Instance /= From.The_Instance then
                Delete (From.Right, The_Instance);
            elsif (From.Left = null) and (From.Right = null) then
                Old_Node (From);
            elsif From.Left = null then
                From := From.Right;
                Old_Node (Old_From);
            elsif From.Right = null then
                From := From.Left;
                Old_Node (Old_From);
            else
                Get (From.Left, From.The_Instance); -- move most right
            end if;
        end if;
    end Delete;

    procedure Delete (The_Instance : Instance) is
    begin
        Delete (The_Root, The_Instance);
    end Delete;


    function Is_Empty return Boolean is
    begin
        return The_Root = null;
    end Is_Empty;


    procedure Put (At_Index     : Positive;
                   The_Instance : Instance;
                   Where        : Output_Stream.Object) is  
        use Output_Stream;
    begin
        if At_Index /= 1 then
            Put_Line (',', Where);
        end if;
        Put (At_Index, Where);
        Put (" => ", Where);
        Put (The_Instance, Where);
    end Put;


    procedure Put (The_Tree : Access_Node; Where : Output_Stream.Object) is
        Index : Positive := 1;
        procedure R_Put (The_Tree : Access_Node;
                         Where    : Output_Stream.Object) is
            use Output_Stream;
        begin
            if The_Tree /= null then
                R_Put (The_Tree.Right, Where);
                Put (Index, The_Tree.The_Instance, Where);
                Index := Index + 1;
                R_Put (The_Tree.Left, Where);
            end if;
        end R_Put;
    begin
        Output_Stream.Put_Line ("Conflict_set'(", Where);
        Output_Stream.Indent (+2, Where);  
        R_Put (The_Tree, Where);
        Output_Stream.Indent (-2, Where);
        Output_Stream.Put_Line (")", Where);
    end Put;

    procedure Put (Where : Output_Stream.Object) is
    begin
        Put (The_Tree => The_Root, Where => Where);
    end Put;

end Generic_Conflict_Set;