DataMuseum.dk

top - download

    Length: 3377 (0xd31)
    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 Generic_Tree is
    type Node is
        record
            The_Element : Element;
            Left_Tree : Tree;
            Right_Tree : Tree;
        end record;

    procedure Copy (From_Tree : Tree; To_Tree : in out Tree) is
    begin
        if From_Tree = null then
            To_Tree := null;
        else
            To_Tree := new Node'(The_Element => From_Tree.The_Element,
                                 Left_Tree => null,
                                 Right_Tree => null);
            Copy (From_Tree.Left_Tree, To_Tree.Left_Tree);
            Copy (From_Tree.Right_Tree, To_Tree.Right_Tree);
        end if;
    exception
        when Storage_Error =>
            raise Overflow;
    end Copy;


    procedure Vider (The_Tree : in out Tree) is
    begin
        The_Tree := null;
    end Vider;


    procedure Construct (The_Element : Element;
                         The_Tree : in out Tree;
                         To_Child : Child) is
    begin
        if To_Child = Left then
            The_Tree := new Node'(The_Element => The_Element,
                                  Left_Tree => The_Tree,
                                  Right_Tree => null);
        else
            The_Tree := new Node'(The_Element => The_Element,
                                  Left_Tree => null,
                                  Right_Tree => The_Tree);
        end if;
    exception
        when Storage_Error =>
            raise Overflow;
    end Construct;


    procedure Put_Element (From_Tree : in out Tree; The_Element : Element) is
    begin
        From_Tree.The_Element := The_Element;
    exception
        when Constraint_Error =>
            raise Tree_Is_Void;
    end Put_Element;


    procedure Change_Child (The_Child : Child;
                            From_Tree : in out Tree;
                            To_Tree : in out Tree) is
        Temp_Node : Tree;
    begin
        if The_Child = Left then
            Temp_Node := From_Tree.Left_Tree;
            From_Tree.Left_Tree := To_Tree;
        else
            Temp_Node := From_Tree.Right_Tree;
            From_Tree.Right_Tree := To_Tree;
        end if;
        To_Tree := Temp_Node;
    exception
        when Constraint_Error =>
            raise Tree_Is_Void;
    end Change_Child;


    function Is_Equal (Left : Tree; Right : Tree) return Boolean is
    begin
        if Left.The_Element /= Right.The_Element then
            return False;
        else
            return Is_Equal (Left.Left_Tree, Right.Left_Tree) and then
                      Is_Equal (Left.Right_Tree, Right.Right_Tree);
        end if;
    exception
        when Constraint_Error =>
            return False;
    end Is_Equal;


    function Is_Void (The_Tree : Tree) return Boolean is
    begin
        return (The_Tree = null);
    end Is_Void;


    function Element_From (The_Tree : Tree) return Element is
    begin
        return The_Tree.The_Element;
    exception
        when Constraint_Error =>
            raise Tree_Is_Void;
    end Element_From;


    function Child_Of (The_Tree : Tree; The_Child : Child) return Tree is
    begin
        if The_Child = Left then
            return The_Tree.Left_Tree;
        else
            return The_Tree.Right_Tree;
        end if;
    exception
        when Constraint_Error =>
            raise Tree_Is_Void;
    end Child_Of;
end Generic_Tree;