path: root/src/packrat-graphs.adb

with

    Ada.Unchecked_Deallocation;


package body Packrat.Graphs is


    procedure Free_Element_Array is new Ada.Unchecked_Deallocation
        (Element_Array, Element_Array_Access);





    function "<"
           (Left, Right : in Choice_Down)
        return Boolean is
    begin
        return Left.From < Right.From or else
            (Left.From = Right.From and Left.Choice < Right.Choice);
    end "<";





    procedure Adjust
           (This : in out Elem_Wrapper)
    is
        New_Array : Element_Array_Access;
    begin
        if This.Data /= null then
            New_Array := new Element_Array (This.Data'First .. This.Data'Last);
            New_Array.all := This.Data.all;
            This.Data := New_Array;
        end if;
    end Adjust;


    procedure Finalize
           (This : in out Elem_Wrapper) is
    begin
        if This.Data /= null then
            Free_Element_Array (This.Data);
        end if;
    end Finalize;


    function Wrap
           (Data : in Element_Array)
        return Elem_Wrapper
    is
        New_Array : Element_Array_Access :=
            new Element_Array (Data'First .. Data'Last);
    begin
        New_Array.all := Data;
        return (Ada.Finalization.Controlled with Data => New_Array);
    end Wrap;





    function Leaf
           (New_Item : in Element_Array;
            Start    : in Positive;
            Finish   : in Natural)
        return Node is
    begin
        return This : Node do
            This.Kind := Leaf_Node;
            This.Content := Wrap (New_Item);
            This.Start := Start;
            This.Finish := Finish;
        end return;
    end Leaf;


    function Branch
           (Label  : in Label_Enum;
            Start  : in Positive;
            Finish : in Natural)
        return Node is
    begin
        return This : Node do
            This.Kind := Branch_Node;
            This.Ident := Label;
            This.Start := Start;
            This.Finish := Finish;
        end return;
    end Branch;





    function Is_Leaf
           (This : in Node)
        return Boolean is
    begin
        return This.Kind = Leaf_Node;
    end Is_Leaf;


    function Is_Branch
           (This : in Node)
        return Boolean is
    begin
        return This.Kind = Branch_Node;
    end Is_Branch;





    function Label
           (This : in Node)
        return Label_Enum is
    begin
        return This.Ident;
    end Label;


    function Elements
           (This : in Node)
        return Element_Array is
    begin
        return This.Content.Data.all;
    end Elements;


    function Start
           (This : in Node)
        return Positive is
    begin
        return This.Start;
    end Start;


    function Finish
           (This : in Node)
        return Natural is
    begin
        return This.Finish;
    end Finish;





    function Is_Nothing
           (Position : in Cursor)
        return Boolean is
    begin
        return Position.My_Graph = null or else
            Position.Index = 0 or else
            Position.Index > Position.My_Graph.all.Node_List.Last_Index or else
            Position.My_Graph.all.Node_List.Element (Position.Index).Kind = Null_Node;
    end Is_Nothing;





    function Depth
           (Position : in Cursor)
        return Natural is
    begin
        return Natural (Position.Track.Length);
    end Depth;


    function Is_Node
           (Position : in Cursor)
        return Boolean is
    begin
        return not Is_Nothing (Position);
    end Is_Node;


    function Is_Root
           (Position : in Cursor)
        return Boolean is
    begin
        return Position.My_Graph /= null and then
            Position.My_Graph.all.Root_List.Contains (Position.Index) and then
            Depth (Position) = 0;
    end Is_Root;


    function Is_Branch
           (Position : in Cursor)
        return Boolean is
    begin
        return Position.My_Graph /= null and then
            Position.Index /= 0 and then
            Position.Index <= Position.My_Graph.all.Node_List.Last_Index and then
            Position.My_Graph.all.Node_List.Element (Position.Index).Kind = Branch_Node;
    end Is_Branch;


    function Is_Leaf
           (Position : in Cursor)
        return Boolean is
    begin
        return Position.My_Graph /= null and then
            Position.Index /= 0 and then
            Position.Index <= Position.My_Graph.all.Node_List.Last_Index and then
            Position.My_Graph.all.Node_List.Element (Position.Index).Kind = Leaf_Node;
    end Is_Leaf;


    function Label
           (Position : in Cursor)
        return Label_Enum is
    begin
        return Position.My_Graph.all.Node_List.Element (Position.Index).Ident;
    end Label;


    function Elements
           (Position : in Cursor)
        return Element_Array is
    begin
        return Position.My_Graph.all.Node_List.Element (Position.Index).Content.Data.all;
    end Elements;





    function Start
           (Position : in Cursor)
        return Positive is
    begin
        return Position.My_Graph.all.Node_List.Element (Position.Index).Start;
    end Start;


    function Finish
           (Position : in Cursor)
        return Natural is
    begin
        return Position.My_Graph.all.Node_List.Element (Position.Index).Finish;
    end Finish;


    function Choices
           (My_Graph : in Graph;
            My_Index : in Node_Index)
        return Natural is
    begin
        if not My_Graph.Choices.Contains (My_Index) then
            return 0;
        else
            return My_Graph.Choices.Element (My_Index);
        end if;
    end Choices;


    function Choices
           (Position : in Cursor)
        return Natural is
    begin
        if not Is_Branch (Position) then
            return 0;
        else
            return Choices (Position.My_Graph.all, Position.Index);
        end if;
    end Choices;





    function Parent
           (Position : in Cursor)
        return Cursor is
    begin
        return Result : Cursor do
            Result.My_Graph := Position.My_Graph;
            Result.Track := Position.Track;
            if Natural (Position.Track.Length) = 0 then
                Result.Index := 0;
            else
                Result.Index := Position.Track.Last_Element.From;
                Result.Track.Delete_Last;
            end if;
        end return;
    end Parent;


    function Child_Count
           (Position : in Cursor;
            Choice   : in Positive)
        return Natural is
    begin
        return Natural (Position.My_Graph.all.Down_Edges.Element ((Position.Index, Choice)).Length);
    end Child_Count;


    function Child_Count
           (Position : in Cursor)
        return Natural
    is
        Choice_Count : Natural := Choices (Position);
    begin
        if Choice_Count = 0 then
            return 0;
        else
            return Natural (Position.My_Graph.all.Down_Edges.Element
                ((Position.Index, Choice_Count)).Length);
        end if;
    end Child_Count;


    function All_Child_Count
           (Position : in Cursor)
        return Natural
    is
        Result : Natural := 0;
    begin
        for C in Integer range 1 .. Choices (Position) loop
            Result := Result + Child_Count (Position, C);
        end loop;
        return Result;
    end All_Child_Count;


    function First_Child
           (Position : in Cursor;
            Choice   : in Positive)
        return Cursor is
    begin
        return Result : Cursor do
            Result.My_Graph := Position.My_Graph;
            Result.Index := Position.My_Graph.all.Down_Edges.Element
                ((Position.Index, Choice)).First_Element;
            Result.Track := Position.Track;
            Result.Track.Append ((Position.Index, Choice));
        end return;
    end First_Child;


    function Last_Child
           (Position : in Cursor;
            Choice   : in Positive)
        return Cursor is
    begin
        return Result : Cursor do
            Result.My_Graph := Position.My_Graph;
            Result.Index := Position.My_Graph.all.Down_Edges.Element
                ((Position.Index, Choice)).Last_Element;
            Result.Track := Position.Track;
            Result.Track.Append ((Position.Index, Choice));
        end return;
    end Last_Child;


    function First_Child
           (Position : in Cursor)
        return Cursor
    is
        Choice : Natural := Choices (Position);
    begin
        return Result : Cursor do
            Result.My_Graph := Position.My_Graph;
            if Choice = 0 or Result.My_Graph = null then
                Result.Index := 0;
            else
                Result.Index := Position.My_Graph.all.Down_Edges.Element
                    ((Position.Index, Choice)).First_Element;
            end if;
            Result.Track := Position.Track;
            Result.Track.Append ((Position.Index, Choice));
        end return;
    end First_Child;


    function Last_Child
           (Position : in Cursor)
        return Cursor
    is
        Choice : Natural := Choices (Position);
    begin
        return Result : Cursor do
            Result.My_Graph := Position.My_Graph;
            if Choice = 0 or Result.My_Graph = null then
                Result.Index := 0;
            else
                Result.Index := Position.My_Graph.all.Down_Edges.Element
                    ((Position.Index, Choice)).Last_Element;
            end if;
            Result.Track := Position.Track;
            Result.Track.Append ((Position.Index, Choice));
        end return;
    end Last_Child;


    function Next_Sibling
           (Position : in Cursor)
        return Cursor
    is
        Parent_Index : Extended_Node_Index;
        Choice       : Natural;
        Sibling      : Index_Vectors.Cursor;
    begin
        if Depth (Position) = 0 then
            Parent_Index := 0;
            Choice := 0;
        else
            Parent_Index := Position.Track.Last_Element.From;
            Choice := Position.Track.Last_Element.Choice;
        end if;
        return Result : Cursor do
            Result.My_Graph := Position.My_Graph;
            if Choice = 0 or Parent_Index = 0 or Result.My_Graph = null or Position.Index = 0 then
                Result.Index := 0;
            else
                Sibling := Result.My_Graph.all.Down_Edges.Element
                    ((Parent_Index, Choice)).Find (Position.Index);
                Index_Vectors.Next (Sibling);
                if Index_Vectors.Has_Element (Sibling) then
                    Result.Index := Index_Vectors.Element (Sibling);
                else
                    Result.Index := 0;
                end if;
            end if;
            Result.Track := Position.Track;
        end return;
    end Next_Sibling;


    function Prev_Sibling
           (Position : in Cursor)
        return Cursor
    is
        Parent_Index : Extended_Node_Index;
        Choice       : Natural;
        Sibling      : Index_Vectors.Cursor;
    begin
        if Depth (Position) = 0 then
            Parent_Index := 0;
            Choice := 0;
        else
            Parent_Index := Position.Track.Last_Element.From;
            Choice := Position.Track.Last_Element.Choice;
        end if;
        return Result : Cursor do
            Result.My_Graph := Position.My_Graph;
            if Choice = 0 or Parent_Index = 0 or Result.My_Graph = null or Position.Index = 0 then
                Result.Index := 0;
            else
                Sibling := Result.My_Graph.all.Down_Edges.Element
                    ((Parent_Index, Choice)).Find (Position.Index);
                Index_Vectors.Previous (Sibling);
                if Index_Vectors.Has_Element (Sibling) then
                    Result.Index := Index_Vectors.Element (Sibling);
                else
                    Result.Index := 0;
                end if;
            end if;
            Result.Track := Position.Track;
        end return;
    end Prev_Sibling;





    procedure Delete_Loose_Subgraph
           (Container : in out Graph;
            Index     : in     Node_Index)
    is
        use type Ada.Containers.Count_Type;
        Number_Choices : Natural;
    begin
        if  Container.Up_Edges.Contains (Index) and then
            Container.Up_Edges.Reference (Index).Length > 0
        then
            --  If this subgraph is still connected to the rest of the graph,
            --  then we do nothing.
            return;
        end if;

        if Container.Choices.Contains (Index) then
            Number_Choices := Container.Choices.Element (Index);
        else
            Number_Choices := 0;
        end if;

        for C in reverse Integer range 1 .. Number_Choices loop
            declare
                Edges : Edge_Down_Maps.Reference_Type :=
                    Container.Down_Edges.Reference ((Index, C));
            begin
                for I in reverse Integer range 1 .. Edges.Last_Index loop
                    declare
                        Elem : Node_Index := Edges.Element.Element (I);
                    begin
                        Container.Delete_Up_Edge (Elem, Index);
                        Container.Delete_Loose_Subgraph (Elem);
                    end;
                end loop;
            end;
            Container.Delete_Down_Edges (Index, C);
        end loop;

        Container.Node_List.Reference (Index).Kind := Null_Node;
        if Index < Container.Add_Place then
            Container.Add_Place := Index;
        end if;
        while Container.Node_List.Length > 0 and then
            Container.Node_List.Last_Element.Kind = Null_Node
        loop
            Container.Node_List.Delete_Last;
        end loop;

        if Container.Root_List.Contains (Index) then
            Container.Root_List.Delete (Container.Root_List.Reverse_Find_Index (Index));
        end if;
    end Delete_Loose_Subgraph;


    procedure Delete_Up_Edge
           (Container       : in out Graph;
            Current, Parent : in     Node_Index)
    is
        Index_List : Edge_Up_Maps.Reference_Type :=
            Container.Up_Edges.Reference (Current);
        Place : Natural := Index_List.Reverse_Find_Index (Parent);
    begin
        Index_List.Delete (Place);
        if Index_List.Is_Empty then
            Container.Up_Edges.Delete (Current);
        end if;
    end Delete_Up_Edge;


    procedure Delete_Down_Edges
           (Container : in out Graph;
            From      : in     Node_Index;
            Choice    : in     Positive)
    is
        Number_Choices : Choice_Maps.Reference_Type := Container.Choices.Reference (From);
    begin
        for C in Integer range Choice + 1 .. Number_Choices loop
            Container.Down_Edges.Replace
              ((From, C - 1),
                Container.Down_Edges.Element ((From, C)));
        end loop;
        Container.Down_Edges.Delete ((From, Number_Choices));
        Number_Choices := Number_Choices - 1;
        if Number_Choices < 1 then
            Container.Choices.Delete (From);
        end if;
    end Delete_Down_Edges;


    procedure Delete_Children
           (Position : in out Cursor;
            Choice   : in     Positive)
    is
        use type Ada.Containers.Count_Type;
        Index_List : Edge_Down_Maps.Reference_Type :=
            Position.My_Graph.all.Down_Edges.Reference ((Position.Index, Choice));
    begin
        for I in reverse Integer range Index_List.First_Index .. Index_List.Last_Index loop
            declare
                Elem : Node_Index := Index_List.Element.Element (I);
            begin
                Position.My_Graph.all.Delete_Up_Edge (Elem, Position.Index);
                Position.My_Graph.all.Delete_Loose_Subgraph (Elem);
            end;
        end loop;
        Position.My_Graph.all.Delete_Down_Edges (Position.Index, Choice);
        while Position.My_Graph.all.Node_List.Length > 0 and then
            Position.My_Graph.all.Node_List.Last_Element.Kind = Null_Node
        loop
            Position.My_Graph.all.Node_List.Delete_Last;
        end loop;
    end Delete_Children;


    procedure Delete_Children
           (Position : in out Cursor)
    is
        Choice : Natural := Choices (Position);
    begin
        if Choice > 0 then
            Delete_Children (Position, Choice);
        end if;
    end Delete_Children;


    procedure Delete_All_Children
           (Position : in out Cursor) is
    begin
        for I in reverse Integer range 1 .. Choices (Position) loop
            Delete_Children (Position, I);
        end loop;
    end Delete_All_Children;





    function Equal_Subgraph
           (Left_Graph, Right_Graph : in Graph;
            Left_Index, Right_Index : in Node_Index)
        return Boolean
    is
        use type Ada.Containers.Count_Type;
    begin
        if  Left_Graph.Node_List.Element (Left_Index) /=
            Right_Graph.Node_List.Element (Right_Index)
        then
            return False;
        end if;

        if  Choices (Left_Graph, Left_Index) /=
            Choices (Right_Graph, Right_Index)
        then
            return False;
        end if;

        for C in Integer range 1 .. Choices (Left_Graph, Left_Index) loop
            declare
                Left_List : Edge_Down_Maps.Constant_Reference_Type :=
                    Left_Graph.Down_Edges.Constant_Reference ((Left_Index, C));
                Right_List : Edge_Down_Maps.Constant_Reference_Type :=
                    Right_Graph.Down_Edges.Constant_Reference ((Right_Index, C));
            begin
                if Left_List.Length /= Right_List.Length then
                    return False;
                end if;
                for I in Integer range 1 .. Left_List.Last_Index loop
                    if not Equal_Subgraph
                       (Left_Graph,
                        Right_Graph,
                        Left_List.Element.Element (I),
                        Right_List.Element.Element (I))
                    then
                        return False;
                    end if;
                end loop;
            end;
        end loop;

        return True;
    end Equal_Subgraph;


    function Equal_Subgraph
           (Left, Right : in Cursor)
        return Boolean is
    begin
        return Equal_Subgraph
           (Left.My_Graph.all,
            Right.My_Graph.all,
            Left.Index,
            Right.Index);
    end Equal_Subgraph;





    function Node_Count
           (Container : in Graph;
            Root_List : in Index_Vectors.Vector)
        return Natural
    is
        Result : Natural := 0;
        Current_Vector : Index_Vectors.Vector := Root_List;
        New_Vector     : Index_Vectors.Vector := Index_Vectors.Empty_Vector;
    begin
        while Natural (Current_Vector.Length) > 0 loop
            Result := Result + Natural (Current_Vector.Length);
            for N of Current_Vector loop
                if  Is_Branch (Container.Node_List.Element (N)) and
                    Container.Choices.Contains (N)
                then
                    for C in Integer range 1 .. Container.Choices.Element (N) loop
                        New_Vector.Append (Container.Down_Edges.Element ((N, C)));
                    end loop;
                end if;
            end loop;
            Current_Vector := New_Vector;
            New_Vector.Clear;
        end loop;
        return Result;
    end Node_Count;


    function Subgraph_Node_Count
           (Position : in Cursor)
        return Natural
    is
        use type Index_Vectors.Vector;
    begin
        return Node_Count
           (Position.My_Graph.all,
            Index_Vectors.Empty_Vector & Position.Index);
    end Subgraph_Node_Count;


    function Find_In_Subgraph
           (Position : in Cursor;
            Item     : in Element_Array)
        return Cursor is
    begin
        return This : Cursor;
    end Find_In_Subgraph;





    function Contains
           (Container : in Graph;
            Position  : in Cursor)
        return Boolean is
    begin
        return Position.My_Graph = Container'Unrestricted_Access and then
            Position.Index < Container.Node_List.Last_Index and then
            Position.Index > 0 and then
            Container.Node_List.Element (Position.Index).Kind /= Null_Node;
    end Contains;




    function Singleton
           (Input : in Node)
        return Graph is
    begin
        return Result : Graph do
            Result.Root_List := Index_Vectors.Empty_Vector;
            Result.Root_List.Append (1);
            Result.Node_List := Node_Vectors.Empty_Vector;
            Result.Node_List.Append (Input);
            Result.Add_Place := 2;
            Result.Choices := Choice_Maps.Empty_Map;
            Result.Down_Edges := Edge_Down_Maps.Empty_Map;
            Result.Up_Edges := Edge_Up_Maps.Empty_Map;
        end return;
    end Singleton;


    function Node_At
           (Container : in Graph;
            Position  : in Cursor)
        return Node_Reference is
    begin
        return (Data => No_Node'Unrestricted_Access);
    end Node_At;





    function Is_Empty
           (Container : in Graph)
        return Boolean is
    begin
        return Container.Root_List.Is_Empty;
    end Is_Empty;


    function Is_Ambiguous
           (Container : in Graph)
        return Boolean is
    begin
        if Natural (Container.Root_List.Length) > 1 then
            return True;
        end if;
        for N in Node_Index range 1 .. Container.Node_List.Last_Index loop
            if  Container.Node_List.Element (N).Kind = Branch_Node and then
                Container.Choices.Contains (N) and then
                Container.Choices.Element (N) > 1
            then
                return True;
            end if;
        end loop;
        return False;
    end Is_Ambiguous;


    function Node_Count
           (Container : in Graph)
        return Natural is
    begin
        return Node_Count (Container, Container.Root_List);
    end Node_Count;





    function Root_Count
           (Container : in Graph)
        return Natural is
    begin
        return Natural (Container.Root_List.Length);
    end Root_Count;


    function Root
           (Container : in Graph;
            Index     : in Positive)
        return Cursor is
    begin
        return Result : Cursor do
            Result.My_Graph := Container'Unrestricted_Access;
            Result.Index := Container.Root_List.Element (Index);
            Result.Track := Choice_Down_Vectors.Empty_Vector;
        end return;
    end Root;





    procedure Append
           (Container : in out Graph;
            Addition  : in     Graph) is
    begin
        null;
    end Append;


    procedure Prepend
           (Container : in out Graph;
            Addition  : in     Graph) is
    begin
        null;
    end Prepend;


    procedure Attach_Choice
           (Container : in out Graph;
            Position  : in     Cursor;
            Addition  : in     Graph) is
    begin
        null;
    end Attach_Choice;





    procedure Clear
           (Container : in out Graph) is
    begin
        Container.Root_List.Clear;
        Container.Node_List.Clear;
        Container.Add_Place := 1;
        Container.Choices.Clear;
        Container.Down_Edges.Clear;
        Container.Up_Edges.Clear;
    end Clear;


    procedure Delete_Position
           (Container : in out Graph;
            Position  : in out Cursor)
    is
        use type Ada.Containers.Count_Type;
    begin
        if Position.Track.Length > 0 then
            Delete_Up_Edge (Container, Position.Index, Position.Track.Last_Element.From);
            declare
                Last : Choice_Down :=
                    Position.Track.Last_Element;
                Ref : Edge_Down_Maps.Reference_Type :=
                    Container.Down_Edges.Reference (Last);
                Number_Choices : Choice_Maps.Reference_Type :=
                    Container.Choices.Reference (Last.From);
            begin
                Ref.Delete (Ref.Find_Index (Position.Index));
                if Ref.Length = 0 then
                    for C in Integer range Last.Choice + 1 .. Number_Choices loop
                        Container.Down_Edges.Replace
                          ((Last.From, C - 1),
                            Container.Down_Edges.Element ((Last.From, C)));
                    end loop;
                    Container.Down_Edges.Delete ((Last.From, Number_Choices));
                    Number_Choices := Number_Choices - 1;
                    if Number_Choices < 1 then
                        Container.Choices.Delete (Last.From);
                    end if;
                end if;
            end;
        end if;
        Delete_Loose_Subgraph (Container, Position.Index);
        while Position.My_Graph.all.Node_List.Length > 0 and then
            Position.My_Graph.all.Node_List.Last_Element.Kind = Null_Node
        loop
            Position.My_Graph.all.Node_List.Delete_Last;
        end loop;
    end Delete_Position;





    function Find
           (Container : in Graph;
            Item      : in Element_Array)
        return Cursor is
    begin
        return This : Cursor;
    end Find;





    function Iterate
           (This : in Graph)
        return Graph_Iterators.Reversible_Iterator'Class is
    begin
        return Result : Reversible_Iterator do
            Result.Position := No_Position;
        end return;
    end Iterate;


    function Iterate_Subtree
           (This     : in Graph;
            Position : in Cursor)
        return Graph_Iterators.Reversible_Iterator'Class is
    begin
        return Result : Reversible_Iterator do
            Result.Position := No_Position;
        end return;
    end Iterate_Subtree;


    function Iterate_Choice
           (This : in Graph;
            Func : in Choosing_Function)
        return Graph_Iterators.Forward_Iterator'Class is
    begin
        return Result : Forward_Iterator do
            Result.Position := No_Position;
        end return;
    end Iterate_Choice;





    function First
           (Object : in Forward_Iterator)
        return Cursor is
    begin
        return No_Position;
    end First;

    function Next
           (Object : in Forward_Iterator;
            Place  : in Cursor)
        return Cursor is
    begin
        return No_Position;
    end Next;





    function First
           (Object : in Reversible_Iterator)
        return Cursor is
    begin
        return No_Position;
    end First;


    function Next
           (Object : in Reversible_Iterator;
            Place  : in Cursor)
        return Cursor is
    begin
        return No_Position;
    end Next;


    function Last
           (Object : in Reversible_Iterator)
        return Cursor is
    begin
        return No_Position;
    end Last;


    function Previous
           (Object : in Reversible_Iterator;
            Place  : in Cursor)
        return Cursor is
    begin
        return No_Position;
    end Previous;


end Packrat.Graphs;