DataMuseum.dk

top - download

    Length: 3304 (0xce8)
    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 Copy (From : in Object; To : in out Object) is
    begin
        if From = null then
            To := null;
        else
            To := new Node'(The_Element => From.The_Element,
                            Under_Tree_Left => null,
                            Under_Tree_Right => null);  
            Copy (From.Under_Tree_Left, To.Under_Tree_Left);
            Copy (From.Under_Tree_Right, To.Under_Tree_Right);
        end if;  
    exception
        when Storage_Error =>
            raise Overflow;
    end Copy;


    procedure Clear (The_Tree : in out Object) is
    begin
        The_Tree := null;
    end Clear;


    procedure Build (The_Element : in Element;
                     The_Tree : in out Object;
                     The_Under_Tree : in Under_Tree) is
    begin
        if The_Under_Tree = Left then
            The_Tree := new Node'(The_Element => The_Element,
                                  Under_Tree_Left => null,
                                  Under_Tree_Right => The_Tree);
        end if;  
    exception
        when Storage_Error =>
            raise Overflow;
    end Build;


    procedure Put_The_Element (The_Tree : in out Object;
                               The_Element : in Element) is
    begin
        The_Tree.The_Element := The_Element;
    exception
        when Constraint_Error =>
            raise Empty_Tree_Error;
    end Put_The_Element;


    procedure Exchange_Under_Tree (The_Under_Tree : in Under_Tree;
                                   From : in out Object;
                                   To : in out Object) is
        Temp_Node : Binary_Tree.Object;
    begin
        if The_Under_Tree = Left then
            Temp_Node := From.Under_Tree_Left;
            From.Under_Tree_Left := To;
        else
            Temp_Node := From.Under_Tree_Right;
            From.Under_Tree_Right := To;
        end if;  
        To := Temp_Node;
    exception
        when Constraint_Error =>
            raise Empty_Tree_Error;
    end Exchange_Under_Tree;


    function Is_Equal (Left : in Object; Right : in Object) return Boolean is
    begin
        if Left.The_Element /= Right.The_Element then
            return False;
        else
            return Is_Equal (Left.Under_Tree_Left,
                             Right.Under_Tree_Left) and then
                   Is_Equal (Left.Under_Tree_Right, Right.Under_Tree_Right);
        end if;  
    exception
        when Constraint_Error =>
            return False;
    end Is_Equal;


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

    function Element_Of (The_Tree : in Object) return Element is
    begin  
        return The_Tree.The_Element;
    exception
        when Constraint_Error =>
            raise Empty_Tree_Error;
    end Element_Of;


    function Under_Tree_Of
                (The_Tree : in Object; The_Under_Tree : in Under_Tree)
                return Object is
    begin
        if The_Under_Tree = Left then
            return The_Tree.Under_Tree_Left;
        else
            return The_Tree.Under_Tree_Right;
        end if;
    exception
        when Constraint_Error =>
            raise Empty_Tree_Error;
    end Under_Tree_Of;
end Binary_Tree;