DataMuseum.dk

top - download

    Length: 3969 (0xf81)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

package body Generic_Btree is

    type Son is (Left, Right);
    Current_Node : Object := Void_Tree;


    function Go_To_Left_Son return Boolean is
        Ok : Boolean := False;
    begin
        if Current_Node /= Void_Tree then
            if Current_Node.Left /= Void_Tree then
                Current_Node := Current_Node.Left;
                Ok := True;
            end if;
        end if;
        return Ok;
    end Go_To_Left_Son;

    function Go_To_Right_Son return Boolean is
        Ok : Boolean := False;
    begin
        if Current_Node /= Void_Tree then
            if Current_Node.Right /= Void_Tree then
                Current_Node := Current_Node.Right;
                Ok := True;
            end if;
        end if;
        return Ok;
    end Go_To_Right_Son;

    function Construct
                (The_Element : Element; On_Son : Son := Right) return Boolean is
        Tmp_Node : Object := new Node'(Contain => The_Element,
                                       Left => Void_Tree,
                                       Right => Void_Tree);
        Ok : Boolean := False;
    begin
        if Current_Node = Void_Tree then
            begin
                Current_Node := Tmp_Node;
                Ok := True;
            end;
        elsif On_Son = Son'(Left) then
            begin
                Current_Node.Left := Tmp_Node;
                Ok := True;
            end;
        else
            begin
                Current_Node.Right := Tmp_Node;
                Ok := True;
            end;
        end if;
        return Ok;
    end Construct;

    function Place_On_Node (One_Element : Element) return Boolean is
        Ok : Boolean := False;
    begin
        if (Current_Node /= Void_Tree) then
            begin
                if Compare_Key (Current_Node.Contain, One_Element) = 0 then
                    return True;
                end if;
                if Compare_Key (Current_Node.Contain, One_Element) > 0 then
                    if Go_To_Left_Son then
                        Ok := Place_On_Node (One_Element);
                    end if;
                else
                    if Go_To_Right_Son then
                        Ok := Place_On_Node (One_Element);
                    end if;
                end if;
            end;
        else
            Ok := False;
        end if;
        return Ok;
    end Place_On_Node;

    procedure Insert_Element (The_Object : in out Object;
                              The_Element : Element) is
        Ok : Boolean;
    begin
        Current_Node := The_Object;
        if Current_Node /= Void_Tree then
            Ok := Place_On_Node (The_Element);
            if Compare_Key (Current_Node.Contain, The_Element) > 0 then
                Ok := Construct (The_Element, Left);
            else
                Ok := Construct (The_Element, Right);
            end if;
        else
            Ok := Construct (The_Element);
            The_Object := Current_Node;
        end if;
    end Insert_Element;

    procedure Search_Element (The_Object : Object;
                              The_Element : in out Element) is
        Ok : Boolean;
    begin
        Current_Node := The_Object;
        Ok := Place_On_Node (The_Element);
        The_Element := Current_Node.Contain;
    end Search_Element;

    function Create_New_Tree return Object is
    begin
        return Void_Tree;
    end Create_New_Tree;

    procedure Change_Element (The_Object : in out Object;
                              The_Element : Element) is
        Ok : Boolean;
    begin
        Current_Node := The_Object;
        if Place_On_Node (The_Element) then
            Current_Node.Contain := The_Element;
        end if;
    end Change_Element;

    function Element_Exist
                (The_Object : Object; The_Element : Element) return Boolean is
    begin
        Current_Node := The_Object;
        return Place_On_Node (The_Element);
    end Element_Exist;


end Generic_Btree;