DataMuseum.dk

top - download

    Length: 3458 (0xd82)
    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 Trees is
    type Node is
        record
            The_Element : Element;
            Left_Subtree, Right_Subtree : Object;
        end record;

    procedure Copy (From_Tree : in Object; To_Tree : in out Object) is
    begin
        if From_Tree = null then
            To_Tree := null;
        else
            To_Tree := new Node'(The_Element => From_Tree.The_Element,
                                 Left_Subtree => null,
                                 Right_Subtree => null);
            Copy (From_Tree.Left_Subtree, To_Tree.Left_Subtree);
            Copy (From_Tree.Right_Subtree, To_Tree.Right_Subtree);
        end if;  
    exception
        when Storage_Error =>
            raise Overfull;
    end Copy;


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


    procedure Build (The_Element : Element;
                     The_Tree : in out Object;
                     Of_The_Son : Son) is
    begin
        if Of_The_Son = Left then
            The_Tree := new Node'(The_Element => The_Element,
                                  Left_Subtree => The_Tree,
                                  Right_Subtree => null);
        else
            The_Tree := new Node'(The_Element => The_Element,
                                  Left_Subtree => null,
                                  Right_Subtree => The_Tree);
        end if;  
    exception
        when Storage_Error =>
            raise Overfull;  
    end Build;


    procedure Put (From_Tree : in out Object; To_Element : Element) is
    begin
        From_Tree.The_Element := To_Element;
    exception
        when Storage_Error =>
            raise Tree_Is_Empty;
    end Put;


    procedure Swap (The_Son : Son;
                    From_Tree : in out Object;
                    With_Tree : in out Object) is
        Temporary_Node : Object;
    begin
        if The_Son = Left then
            Temporary_Node := From_Tree.Left_Subtree;
            From_Tree.Left_Subtree := With_Tree;
        else
            Temporary_Node := From_Tree.Right_Subtree;
            From_Tree.Right_Subtree := With_Tree;
        end if;
        With_Tree := Temporary_Node;
    exception
        when Storage_Error =>
            raise Tree_Is_Empty;
    end Swap;


    function Is_Equal (Left, Right : Object) return Boolean is
    begin
        if Left = null and Right = null then
            return True;
        elsif Left = null or Right = null then
            return False;
        else
            return  
               Left.The_Element = Right.The_Element and then
                  Is_Equal (Left.Left_Subtree, Right.Left_Subtree) and then
                  Is_Equal (Left.Right_Subtree, Right.Right_Subtree);
        end if;
    end Is_Equal;


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


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


    function Son_Of (The_Tree : Object; The_Son : Son) return Object is
    begin
        if The_Son = Left then
            return The_Tree.Left_Subtree;
        else
            return The_Tree.Right_Subtree;
        end if;
    exception
        when Constraint_Error =>
            raise Tree_Is_Empty;
    end Son_Of;

end Trees;