DataMuseum.dk

top - metrics - download

    Length: 3446 (0xd76)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

package body Binary_Tree is

    procedure Clear_Out (The_Tree : in out Object) is
    begin
        The_Tree := Empty_Tree;
    end Clear_Out;

    procedure Build (The_Element : in Element; In_The_Tree : in out Object) is
    begin
        In_The_Tree := new Node'(Value => The_Element,
                                 Under_Left_Tree => Empty_Tree,
                                 Under_Right_Tree => Empty_Tree);
    exception
        when Storage_Error =>
            raise Overflow;
    end Build;

    procedure Insert (The_Element : in Element; In_The_Tree : in out Object) is
    begin
        if Is_Empty (In_The_Tree) then
            Build (The_Element, In_The_Tree);
        else
            if "<" (The_Element, In_The_Tree.Value) then
                Insert (The_Element, In_The_Tree.Under_Left_Tree);
            else
                Insert (The_Element, In_The_Tree.Under_Right_Tree);
            end if;
        end if;
    end Insert;

    procedure Duplicate (The_Source_Tree : in Object;
                         The_Destination_Tree : in out Object) is
    begin  
        if Is_Empty (The_Source_Tree) then
            The_Destination_Tree := Empty_Tree;
        else
            The_Destination_Tree := new Node'(Value => The_Source_Tree.Value,
                                              Under_Left_Tree => Empty_Tree,
                                              Under_Right_Tree => Empty_Tree);
            Duplicate (The_Source_Tree.Under_Left_Tree,
                       The_Destination_Tree.Under_Left_Tree);
            Duplicate (The_Source_Tree.Under_Right_Tree,
                       The_Destination_Tree.Under_Right_Tree);
        end if;
    exception
        when Storage_Error =>
            raise Overflow;
    end Duplicate;

    procedure Get_Under_Left_Tree (Of_The_Tree : in Object;
                                   In_The_Tree : in out Object) is
    begin
        In_The_Tree := Of_The_Tree.Under_Left_Tree;
    end Get_Under_Left_Tree;

    procedure Get_Under_Right_Tree (Of_The_Tree : in Object;
                                    In_The_Tree : in out Object) is
    begin
        In_The_Tree := Of_The_Tree.Under_Right_Tree;
    end Get_Under_Right_Tree;


    procedure Visit_Lrr (The_Tree : in Object) is
    begin
        if not Is_Empty (The_Tree) then
            Visit_Lrr (The_Tree.Under_Left_Tree);
            Handle (The_Tree.Value);
            Visit_Lrr (The_Tree.Under_Right_Tree);
        end if;
    end Visit_Lrr;

    function Is_Empty (The_Tree : Object) return Boolean is
    begin
        return The_Tree = Empty_Tree;
    end Is_Empty;

    function Find (The_Element : Element; In_The_Tree : Object)
                  return Boolean is
    begin

        if Is_Empty (In_The_Tree) then
            return False;
        end if;
        if The_Element = In_The_Tree.Value then
            return True;
        else
            if "<" (The_Element, In_The_Tree.Value) then
                return Find (The_Element, In_The_Tree.Under_Left_Tree);
            else
                return Find (The_Element, In_The_Tree.Under_Left_Tree);
            end if;
        end if;
    end Find;

    procedure Get_Value (Of_The_Tree : in Object;
                         In_The_Element : in out Element) is
    begin
        In_The_Element := Of_The_Tree.Value;
    exception
        when Constraint_Error =>
            raise Tree_Is_Empty;
    end Get_Value;

end Binary_Tree;