path: root/src/packrat-parse_graphs.adb

--  This source is licensed under the Sunset License v1.0


with

    Ada.Strings.Fixed,
    Ada.Characters.Latin_1;


package body Packrat.Parse_Graphs is


    package SU renames Ada.Strings.Unbounded;
    package Latin renames Ada.Characters.Latin_1;




    function "="
           (Left, Right : in Parse_Graph)
        return Boolean
    is
        use type Base.Graph;
        use type Finished_Token_Vectors.Vector;
        use type Node_Label_Maps.Map;
    begin
        return Left.Internal_Graph = Right.Internal_Graph and
            Left.Root_Elems = Right.Root_Elems and
            Left.Label_Map = Right.Label_Map;
    end "=";


    function "<"
           (Left, Right : in Finished_Token_Vectors.Vector)
        return Boolean
    is
        use type Ada.Containers.Count_Type;
        use type Traits.Tokens.Finished_Token_Type;
        Left_Index : Positive := Left.First_Index;
        Right_Index : Positive := Right.First_Index;
    begin
        while Left_Index <= Left.Last_Index and Right_Index <= Right.Last_Index loop
            if Left.Element (Left_Index) < Right.Element (Right_Index) then
                return True;
            elsif Left.Element (Left_Index) /= Right.Element (Right_Index) then
                return False;
            end if;
            Left_Index := Left_Index + 1;
            Right_Index := Right_Index + 1;
        end loop;
        return Left.Length < Right.Length;
    end "<";


    function "<"
           (Left, Right : in Token_Group)
        return Boolean
    is
        use type Finished_Token_Vectors.Vector;
    begin
        if Traits.Tokens.Start (Left.Parent.Token) = Traits.Tokens.Start (Right.Parent.Token) then
            if Finish (Left) = Finish (Right) then
                return Left.Elems < Right.Elems;
            else
                return Finish (Left) < Finish (Right);
            end if;
        else
            return Traits.Tokens.Start (Left.Parent.Token) <
                Traits.Tokens.Start (Right.Parent.Token);
        end if;
    end "<";





    procedure Assign
           (Target : in out Parse_Graph;
            Source : in     Parse_Graph) is
    begin
        Target.Internal_Graph.Assign (Source.Internal_Graph);
        Target.Root_Elems.Assign (Source.Root_Elems);
        Target.Label_Map.Assign (Source.Label_Map);
    end Assign;


    function Copy
           (Source : in Parse_Graph)
        return Parse_Graph is
    begin
        return G : Parse_Graph :=
           (Internal_Graph => Source.Internal_Graph.Copy,
            Root_Elems     => Source.Root_Elems.Copy,
            Label_Map      => Source.Label_Map.Copy);
    end Copy;


    procedure Move
           (Target, Source : in out Parse_Graph) is
    begin
        Target.Internal_Graph.Move (Source.Internal_Graph);
        Target.Root_Elems.Move (Source.Root_Elems);
        Target.Label_Map.Move (Source.Label_Map);
    end Move;





    function Is_Empty
           (Container : in Parse_Graph)
        return Boolean is
    begin
        return Container.Label_Map.Is_Empty;
    end Is_Empty;


    procedure Clear
           (Container : in out Parse_Graph) is
    begin
        Container.Internal_Graph.Clear;
        Container.Root_Elems.Clear;
        Container.Label_Map.Clear;
    end Clear;





    function In_Finishes
           (Container : in Parse_Graph;
            Node      : in Node_ID_Type)
        return Finish_Vectors.Vector
    is
        Result : Finish_Vectors.Vector;
        Current : Traits.Tokens.Finish_Type;
        Node_Label : Traits.Tokens.Token_Type;
    begin
        Node_Label := Container.Internal_Graph.Label (Node);
        for Fin_Token of Container.Root_Elems loop
            if Fin_Token.Token = Node_Label and then
                not Result.Contains (Fin_Token.Finish)
            then
                Result.Append (Fin_Token.Finish);
            end if;
        end loop;
        for Edge of Container.Internal_Graph.Inbound (Node) loop
            Current := Container.Internal_Graph.Label (Edge).Subnode_Finish;
            if not Result.Contains (Current) then
                Result.Append (Current);
            end if;
        end loop;
        return Result;
    end In_Finishes;





    function Debug_String
           (Container : in Parse_Graph)
        return String
    is
        function Generate_Map
               (Container : in Parse_Graph)
            return Enum_Node_Maps.Map
        is
            Result : Enum_Node_Maps.Map;
            Current : Traits.Label_Enum;
        begin
            for Node of Container.Internal_Graph.Nodes loop
                Current := Traits.Tokens.Label (Container.Internal_Graph.Label (Node));
                if not Result.Contains (Current) then
                    Result.Insert (Current, Node_Vectors.Empty_Vector);
                end if;
                Result.Reference (Current).Append (Node);
            end loop;
            return Result;
        end Generate_Map;

        function Image
               (Input : in Integer)
            return String is
        begin
            return Ada.Strings.Fixed.Trim (Integer'Image (Input), Ada.Strings.Left);
        end Image;

        Mapping  : Enum_Node_Maps.Map := Generate_Map (Container);
        Current  : Traits.Tokens.Token_Type;
        Result   : SU.Unbounded_String;
    begin
        if Container.Is_Empty then
            return "";
        end if;
        for Iter in Mapping.Iterate loop
            SU.Append (Result, Traits.Label_Enum'Image (Enum_Node_Maps.Key (Iter)) & Latin.LF);
            for Node of Enum_Node_Maps.Element (Iter) loop
                Current := Container.Internal_Graph.Label (Node);
                SU.Append (Result, " " & Image (Traits.Tokens.Start (Current)) & " ->" & Latin.HT);
                for Fin of In_Finishes (Container, Node) loop
                    SU.Append (Result, Image (Fin) & " ->" & Latin.HT);
                    declare
                        A_Fin_Token : Traits.Tokens.Finished_Token_Type := (Current, Fin);
                        Groupings : Token_Group_Array := Container.Subgroups (A_Fin_Token);
                    begin
                        if Groupings'Length = 0 then
                            SU.Append (Result, "Leaf" & Latin.LF);
                            SU.Append (Result, SU."*" (2, Latin.HT));
                        else
                            for Grouping of Groupings loop
                                for Fin_Token of Elements (Grouping) loop
                                    SU.Append (Result, "Sub " &
                                        Traits.Label_Enum'Image
                                            (Traits.Tokens.Label (Fin_Token.Token)) &
                                        " (" & Image (Traits.Tokens.Start (Fin_Token.Token)) &
                                        "," & Image (Fin_Token.Finish) & "), ");
                                end loop;
                                SU.Delete (Result, SU.Length (Result) - 1, SU.Length (Result));
                                SU.Append (Result, Latin.LF);
                                SU.Append (Result, SU."*" (2, Latin.HT));
                            end loop;
                        end if;
                    end;
                    SU.Delete (Result, SU.Length (Result), SU.Length (Result));
                end loop;
                SU.Delete (Result, SU.Length (Result), SU.Length (Result));
            end loop;
            SU.Delete (Result, SU.Length (Result), SU.Length (Result));
            SU.Append (Result, Latin.LF & Latin.LF);
        end loop;
        if SU.Length (Result) > 1 then
            SU.Delete (Result, SU.Length (Result) - 1, SU.Length (Result));
        end if;
        SU.Append (Result, Latin.LF);
        return SU.To_String (Result);
    end Debug_String;





    function Contains
           (Container : in Parse_Graph;
            Token     : in Traits.Tokens.Token_Type)
        return Boolean is
    begin
        return Container.Label_Map.Contains (Token);
    end Contains;


    function Contains
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Boolean
    is
        use type Traits.Tokens.Finished_Token_Type;
        Node : Node_ID_Type;
    begin
        if not Container.Contains (Position.Token) then
            return False;
        end if;
        for F of Container.Root_Elements loop
            if F = Position then
                return True;
            end if;
        end loop;
        Node := Container.Label_Map.Element (Position.Token);
        return (for some Edge of Container.Internal_Graph.Inbound (Node) =>
            Container.Internal_Graph.Label (Edge).Subnode_Finish = Position.Finish);
    end Contains;


    function Contains
           (Container : in Parse_Graph;
            Grouping  : in Token_Group)
        return Boolean is
    begin
        return Container.Contains (Grouping.Parent, Elements (Grouping));
    end Contains;


    function Contains
           (Container : in Parse_Graph;
            Parent    : in Traits.Tokens.Finished_Token_Type;
            Subtokens : in Traits.Tokens.Finished_Token_Array)
        return Boolean
    is
        Groups  : Group_ID_Vectors.Vector;
        Next_ID : Group_ID_Type;
        Parent_Node : Node_ID_Type;
    begin
        if not Container.Contains (Parent.Token) then
            return False;
        end if;
        for Fin_Token of Subtokens loop
            if not Container.Contains (Fin_Token.Token) then
                return False;
            end if;
        end loop;
        if not Valid_Starts_Finishes (Parent, Subtokens) then
            return False;
        end if;
        Parent_Node := Container.Label_Map.Element (Parent.Token);
        for Edge of Container.Internal_Graph.Outbound (Parent_Node) loop
            Next_ID := Container.Internal_Graph.Label (Edge).Group_ID;
            if not Groups.Contains (Next_ID) then
                Groups.Append (Next_ID);
            end if;
        end loop;
        return (for some ID of Groups =>
            (for all Sub of Subtokens =>
                (for some Edge of Container.Internal_Graph.Between
                  (Parent_Node, Container.Label_Map.Element (Sub.Token)) =>
                    Container.Internal_Graph.Label (Edge) =
                       (Group_ID => ID,
                        Group_Finish => Parent.Finish,
                        Subnode_Finish => Sub.Finish))));
    end Contains;


    function Reachable
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Boolean
    is
        --  This is basically a depth first search function.
        function Finder
               (Current : in Traits.Tokens.Finished_Token_Type)
            return Boolean
        is
            use type Traits.Tokens.Finished_Token_Type;
        begin
            return Current = Position or else
                (for some Grouping of Container.Subgroups (Current) =>
                    (for some Fin_Token of Elements (Grouping) => Finder (Fin_Token)));
        end Finder;
    begin
        return (for some Fin_Token of Container.Root_Elements => Finder (Fin_Token));
    end Reachable;


    function Locally_Reachable
           (Container : in Parse_Graph;
            Node      : in Node_ID_Type)
        return Boolean
    is
        use type Ada.Containers.Count_Type;
    begin
        for Fin_Token of Container.Root_Elems loop
            if Container.Label_Map.Element (Fin_Token.Token) = Node then
                return True;
            end if;
        end loop;
        if Container.Internal_Graph.Indegree (Node) > 0 then
            return True;
        end if;
        return False;
    end Locally_Reachable;


    function Unreachable_Outbound
           (Container : in Parse_Graph;
            Node      : in Node_ID_Type)
        return Base.Edge_Array
    is
        Outedges : Base.Edge_Array := Container.Internal_Graph.Outbound (Node);
        Unreachout : Base.Edge_Array (1 .. Outedges'Length);
        In_Fins : Finish_Vectors.Vector;
        Position : Positive := 1;
    begin
        if Outedges'Length = 0 then
            return Unreachout;
        end if;
        In_Fins := In_Finishes (Container, Node);
        for Edge of Outedges loop
            if not In_Fins.Contains (Container.Internal_Graph.Label (Edge).Group_Finish) then
                Unreachout (Position) := Edge;
                Position := Position + 1;
            end if;
        end loop;
        return Unreachout (1 .. Position - 1);
    end Unreachable_Outbound;


    function All_Reachable
           (Container : in Parse_Graph)
        return Boolean is
    begin
        return (for all Node of Container.Internal_Graph.Nodes =>
            Locally_Reachable (Container, Node) and
            Unreachable_Outbound (Container, Node)'Length = 0);
    end All_Reachable;


    function Valid_Token
           (Fin_Token : in Traits.Tokens.Finished_Token_Type)
        return Boolean is
    begin
        return Fin_Token.Finish + 1 >= Traits.Tokens.Start (Fin_Token.Token);
    end Valid_Token;


    function Valid_Starts_Finishes
           (Parent    : in Traits.Tokens.Finished_Token_Type;
            Subtokens : in Traits.Tokens.Finished_Token_Array)
        return Boolean
    is
        Subvec : Finished_Token_Vectors.Vector;
    begin
        for Sub of Subtokens loop
            if Traits.Tokens.Start (Sub.Token) > Sub.Finish + 1 then
                return False;
            end if;
            Subvec.Append (Sub);
        end loop;
        Finished_Token_Sort.Sort (Subvec);
        for Index in Subvec.First_Index .. Subvec.Last_Index - 1 loop
            if Subvec (Index).Finish >= Traits.Tokens.Start (Subvec (Index + 1).Token) then
                return False;
            end if;
        end loop;
        if Parent.Finish < Subvec.Last_Element.Finish or else
            Traits.Tokens.Start (Parent.Token) > Traits.Tokens.Start (Subvec.First_Element.Token)
        then
            return False;
        end if;
        return True;
    end Valid_Starts_Finishes;


    function Loops_Introduced
           (Container : in Parse_Graph;
            Parent    : in Traits.Tokens.Finished_Token_Type;
            Subtokens : in Traits.Tokens.Finished_Token_Array)
        return Boolean
    is
        function Looper
               (Current : in Traits.Tokens.Finished_Token_Type)
            return Boolean
        is
            use type Traits.Tokens.Finished_Token_Type;
        begin
            if not Container.Contains (Current.Token) then
                return False;
            elsif Current = Parent then
                return True;
            elsif Traits.Tokens.Start (Current.Token) > Traits.Tokens.Start (Parent.Token) then
                return False;
            else
                return (for some Grouping of Container.Subgroups (Current) =>
                    (for some Sub of Elements (Grouping) => Looper (Sub)));
            end if;
        end Looper;
    begin
        return Container.Contains (Parent.Token) and then
            (for some Sub of Subtokens => Looper (Sub));
    end Loops_Introduced;


    function Is_Sorted
           (Finishes : in Traits.Tokens.Finish_Array)
        return Boolean
    is
        function Actual is new Sorted
            (Traits.Tokens.Finish_Type, Traits.Tokens.Finish_Array);
    begin
        return Actual (Finishes);
    end Is_Sorted;


    function Is_Sorted
           (Positions : in Traits.Tokens.Finished_Token_Array)
        return Boolean
    is
        function Actual is new Sorted
           (Traits.Tokens.Finished_Token_Type,
            Traits.Tokens.Finished_Token_Array,
            Traits.Tokens."<");
    begin
        return Actual (Positions);
    end Is_Sorted;


    function Is_Sorted
           (Groupings : in Token_Group_Array)
        return Boolean
    is
        function Actual is new Sorted (Token_Group, Token_Group_Array);
    begin
        return Actual (Groupings);
    end Is_Sorted;


    function No_Duplicates
           (Finishes : in Traits.Tokens.Finish_Array)
        return Boolean
    is
        function Actual is new No_Dups
            (Traits.Tokens.Finish_Type, Traits.Tokens.Finish_Array);
    begin
        return Actual (Finishes);
    end No_Duplicates;


    function No_Duplicates
           (Positions : in Traits.Tokens.Finished_Token_Array)
        return Boolean
    is
        function Actual is new No_Dups
           (Traits.Tokens.Finished_Token_Type,
            Traits.Tokens.Finished_Token_Array,
            Traits.Tokens."=");
    begin
        return Actual (Positions);
    end No_Duplicates;


    function No_Duplicates
           (Groupings : in Token_Group_Array)
        return Boolean
    is
        function Actual is new No_Dups (Token_Group, Token_Group_Array);
    begin
        return Actual (Groupings);
    end No_Duplicates;





    procedure Include
           (Container : in out Parse_Graph;
            Token     : in     Traits.Tokens.Token_Type)
    is
        Node_ID : Node_ID_Type;
    begin
        if not Container.Contains (Token) then
            Node_ID := Container.Internal_Graph.Unused;
            Container.Internal_Graph.Insert (Base.Labeled_Node_Type'(Node_ID, Token));
            Container.Label_Map.Insert (Token, Node_ID);
        end if;
    end Include;


    procedure Connect
           (Container : in out Parse_Graph;
            Parent    : in     Traits.Tokens.Finished_Token_Type;
            Subtokens : in     Traits.Tokens.Finished_Token_Array)
    is
        Parent_ID : Node_ID_Type;
        Use_GID   : Group_ID_Type;
        New_Edge  : Base.Edge_Type;
        New_Label : Edge_Label_Type;
    begin
        if Container.Contains (Parent, Subtokens) then
            return;
        end if;
        Container.Include (Parent.Token);
        for Sub of Subtokens loop
            Container.Include (Sub.Token);
        end loop;
        Parent_ID := Container.Label_Map.Element (Parent.Token);
        declare
            Outedges : Base.Edge_Array := Container.Internal_Graph.Outbound (Parent_ID);
        begin
            Use_GID := Group_ID_Type'First;
            while (for some E of Outedges =>
                Container.Internal_Graph.Label (E).Group_ID = Use_GID)
            loop
                Use_GID := Use_GID + 1;
            end loop;
        end;
        for Sub of Subtokens loop
            New_Edge :=
               (ID   => Container.Internal_Graph.Unused,
                From => Parent_ID,
                To   => Container.Label_Map.Element (Sub.Token));
            New_Label := (Use_GID, Parent.Finish, Sub.Finish);
            Container.Internal_Graph.Insert (Base.Labeled_Edge_Type'(New_Edge, New_Label));
        end loop;
    end Connect;


    procedure Prune
           (Container : in out Parse_Graph;
            Token     : in     Traits.Tokens.Token_Type) is
    begin
        if not Container.Contains (Token) then
            return;
        end if;
        for I in reverse 1 .. Container.Root_Elems.Last_Index loop
            if Container.Root_Elems.Element (I).Token = Token then
                Container.Root_Elems.Delete (I);
            end if;
        end loop;
        Container.Internal_Graph.Delete (Container.Label_Map (Token));
        Container.Label_Map.Delete (Token);
    end Prune;


    procedure Prune
           (Container : in out Parse_Graph;
            Position  : in     Traits.Tokens.Finished_Token_Type)
    is
        use type Traits.Tokens.Finished_Token_Type;
        Node : Node_ID_Type;
    begin
        if not Container.Contains (Position.Token) then
            return;
        end if;
        for I in reverse 1 .. Container.Root_Elems.Last_Index loop
            if Container.Root_Elems.Element (I) = Position then
                Container.Root_Elems.Delete (I);
            end if;
        end loop;
        Node := Container.Label_Map.Element (Position.Token);
        for Edge of Container.Internal_Graph.Inbound (Node) loop
            if Container.Internal_Graph.Label (Edge).Subnode_Finish = Position.Finish then
                Container.Internal_Graph.Delete (Edge);
            end if;
        end loop;
    end Prune;


    procedure Prune
           (Container : in out Parse_Graph;
            Grouping  : in     Token_Group)
    is
        Group_IDs   : Group_ID_Vectors.Vector;
        Parent_Node : Node_ID_Type;
        Current_ID  : Group_ID_Type;
    begin
        --  Short circuit checks
        if not Container.Contains (Grouping.Parent) then
            return;
        end if;
        for Fin_Token of Elements (Grouping) loop
            if not Container.Contains (Fin_Token) then
                return;
            end if;
        end loop;

        Parent_Node := Container.To_Node (Grouping.Parent);

        --  Gather up the IDs of groups for deletion
        for Edge of Container.Internal_Graph.Between
            (Parent_Node, Container.To_Node (Element (Grouping, 1)))
        loop
            Current_ID := Container.Internal_Graph.Label (Edge).Group_ID;
            if not Group_IDs.Contains (Current_ID) and then
                (for all Index in 2 .. Last_Index (Grouping) =>
                    (for some Other of Container.Internal_Graph.Between
                        (Parent_Node, Container.To_Node (Element (Grouping, Index))) =>
                        Container.Internal_Graph.Label (Other).Group_ID = Current_ID))
            then
                Group_IDs.Append (Current_ID);
            end if;
        end loop;

        --  Delete all relevant edges
        for Fin_Token of Elements (Grouping) loop
            for Edge of Container.Internal_Graph.Between
                (Parent_Node, Container.To_Node (Fin_Token))
            loop
                if Group_IDs.Contains (Container.Internal_Graph.Label (Edge).Group_ID) then
                    Container.Internal_Graph.Delete (Edge);
                end if;
            end loop;
        end loop;
    end Prune;


    procedure Delete_Unreachable
           (Container : in out Parse_Graph)
    is
        Examine, Next : Node_Vectors.Vector;
    begin
        if not Container.Has_Root then
            Container.Clear;
            return;
        end if;
        for Node of Container.Internal_Graph.Nodes loop
            Examine.Append (Node);
        end loop;
        while not Examine.Is_Empty loop
            for Node of Examine loop
                if Container.Internal_Graph.Contains (Node) then
                    if not Locally_Reachable (Container, Node) then
                        for Outnode of Container.Internal_Graph.Children (Node) loop
                            Next.Append (Outnode);
                        end loop;
                        Container.Internal_Graph.Delete (Node);
                    else
                        for Edge of Unreachable_Outbound (Container, Node) loop
                            Next.Append (Edge.To);
                            Container.Internal_Graph.Delete (Edge);
                        end loop;
                    end if;
                end if;
            end loop;
            Examine.Move (Next);
        end loop;
    end Delete_Unreachable;





    function Has_Root
           (Container : in Parse_Graph)
        return Boolean is
    begin
        return not Container.Root_Elems.Is_Empty;
    end Has_Root;


    procedure Set_Root
           (Container : in out Parse_Graph;
            Tokens    : in     Traits.Tokens.Finished_Token_Array) is
    begin
        Container.Clear_Root;
        for Fin_Token of Tokens loop
            if not Container.Root_Elems.Contains (Fin_Token) then
                Container.Root_Elems.Append (Fin_Token);
            end if;
        end loop;
        Finished_Token_Sort.Sort (Container.Root_Elems);
    end Set_Root;


    procedure Clear_Root
           (Container : in out Parse_Graph) is
    begin
        Container.Root_Elems.Clear;
    end Clear_Root;


    function Root_Elements
           (Container : in Parse_Graph)
        return Traits.Tokens.Finished_Token_Array
    is
        function V2A is new Vector_To_Array
           (Traits.Tokens.Finished_Token_Type,
            Traits.Tokens.Finished_Token_Array,
            Finished_Token_Vectors);
    begin
        return V2A (Container.Root_Elems);
    end Root_Elements;





    function Finish_List
           (Container : in Parse_Graph;
            Token     : in Traits.Tokens.Token_Type)
        return Traits.Tokens.Finish_Array
    is
        function V2A is new Vector_To_Array
            (Traits.Tokens.Finish_Type, Traits.Tokens.Finish_Array, Finish_Vectors);
        Result : Finish_Vectors.Vector;
    begin
        for Fin_Token of Container.Root_Elems loop
            if Fin_Token.Token = Token and not Result.Contains (Fin_Token.Finish) then
                Result.Append (Fin_Token.Finish);
            end if;
        end loop;
        for Edge of Container.Internal_Graph.Outbound (Container.Label_Map.Element (Token)) loop
            if not Result.Contains (Container.Internal_Graph.Label (Edge).Group_Finish) then
                Result.Append (Container.Internal_Graph.Label (Edge).Group_Finish);
            end if;
        end loop;
        Finish_Sort.Sort (Result);
        return V2A (Result);
    end Finish_List;


    function Is_Leaf
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Boolean is
    begin
        for Edge of Container.Internal_Graph.Outbound
            (Container.Label_Map.Element (Position.Token))
        loop
            if Container.Internal_Graph.Label (Edge).Group_Finish = Position.Finish then
                return False;
            end if;
        end loop;
        return True;
    end Is_Leaf;


    function Is_Branch
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Boolean is
    begin
        return not Container.Is_Leaf (Position);
    end Is_Branch;





    function Subgroups
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Token_Group_Array
    is
        function V2A is new Vector_To_Array
            (Token_Group, Token_Group_Array, Token_Group_Vectors);
        Groupings  : Group_Finished_Token_Maps.Map;
        Edge_Label : Edge_Label_Type;
        Next_Token : Traits.Tokens.Finished_Token_Type;
        Result     : Token_Group_Vectors.Vector;
    begin
        for Edge of Container.Internal_Graph.Outbound
            (Container.Label_Map.Element (Position.Token))
        loop
            Edge_Label := Container.Internal_Graph.Label (Edge);
            if Edge_Label.Group_Finish = Position.Finish then
                Next_Token :=
                   (Token  => Container.Internal_Graph.Label (Edge.To),
                    Finish => Edge_Label.Subnode_Finish);
                if not Groupings.Contains (Edge_Label.Group_ID) then
                    Groupings.Insert (Edge_Label.Group_ID, Finished_Token_Vectors.Empty_Vector);
                end if;
                Groupings.Reference (Edge_Label.Group_ID).Append (Next_Token);
            end if;
        end loop;
        for Raw_Group of Groupings loop
            Finished_Token_Sort.Sort (Raw_Group);
            Result.Append
              ((Parent => Position,
                Elems  => Raw_Group));
        end loop;
        Token_Group_Sort.Sort (Result);
        return V2A (Result);
    end Subgroups;


    function First_Index
           (Grouping : in Token_Group)
        return Positive is
    begin
        return Grouping.Elems.First_Index;
    end First_Index;


    function Last_Index
           (Grouping : in Token_Group)
        return Positive is
    begin
        return Grouping.Elems.Last_Index;
    end Last_Index;


    function Length
           (Grouping : in Token_Group)
        return Ada.Containers.Count_Type is
    begin
        return Grouping.Elems.Length;
    end Length;


    function Element
           (Grouping : in Token_Group;
            Index    : in Positive)
        return Traits.Tokens.Finished_Token_Type is
    begin
        return Grouping.Elems.Element (Index);
    end Element;


    function Elements
           (Grouping : in Token_Group)
        return Traits.Tokens.Finished_Token_Array
    is
        function V2A is new Vector_To_Array
           (Traits.Tokens.Finished_Token_Type,
            Traits.Tokens.Finished_Token_Array,
            Finished_Token_Vectors);
    begin
        return V2A (Grouping.Elems);
    end Elements;


    function Parent
           (Grouping : in Token_Group)
        return Traits.Tokens.Finished_Token_Type is
    begin
        return Grouping.Parent;
    end Parent;


    function Finish
           (Grouping : in Token_Group)
        return Traits.Tokens.Finish_Type is
    begin
        return Grouping.Parent.Finish;
    end Finish;





    function Is_Root_Ambiguous
           (Container : in Parse_Graph)
        return Boolean
    is
        use type Ada.Containers.Count_Type;
    begin
        return Container.Root_Elems.Length /= 1;
    end Is_Root_Ambiguous;


    function Is_Ambiguous
           (Container : in Parse_Graph)
        return Boolean
    is
        Seen_Finishes : Finish_Group_Maps.Map;
        Edge_Label : Edge_Label_Type;
    begin
        if Container.Has_Root and then Is_Root_Ambiguous (Container) then
            return True;
        end if;
        for Node of Container.Internal_Graph.Nodes loop
            for Edge of Container.Internal_Graph.Outbound (Node) loop
                Edge_Label := Container.Internal_Graph.Label (Edge);
                if Seen_Finishes.Contains (Edge_Label.Group_Finish) then
                    if Seen_Finishes.Element (Edge_Label.Group_Finish) /= Edge_Label.Group_ID then
                        return True;
                    end if;
                else
                    Seen_Finishes.Insert (Edge_Label.Group_Finish, Edge_Label.Group_ID);
                end if;
            end loop;
            Seen_Finishes.Clear;
        end loop;
        return False;
    end Is_Ambiguous;


    function Ambiguities
           (Container      : in     Parse_Graph;
            Ambiguous_Root :    out Boolean)
        return Traits.Tokens.Finished_Token_Array
    is
        function V2A is new Vector_To_Array
           (Traits.Tokens.Finished_Token_Type,
            Traits.Tokens.Finished_Token_Array,
            Finished_Token_Vectors);
        Seen_Finishes : Finish_Group_Maps.Map;
        Edge_Label : Edge_Label_Type;
        Next_Token : Traits.Tokens.Finished_Token_Type;
        Result : Finished_Token_Vectors.Vector;
    begin
        Ambiguous_Root := Container.Has_Root and then Container.Is_Root_Ambiguous;
        for Node of Container.Internal_Graph.Nodes loop
            for Edge of Container.Internal_Graph.Outbound (Node) loop
                Edge_Label := Container.Internal_Graph.Label (Edge);
                if Seen_Finishes.Contains (Edge_Label.Group_Finish) then
                    if Seen_Finishes.Element (Edge_Label.Group_Finish) /= Edge_Label.Group_ID then
                        Next_Token :=
                           (Token  => Container.Internal_Graph.Label (Node),
                            Finish => Edge_Label.Group_Finish);
                        if not Result.Contains (Next_Token) then
                            Result.Append (Next_Token);
                        end if;
                    end if;
                else
                    Seen_Finishes.Insert (Edge_Label.Group_Finish, Edge_Label.Group_ID);
                end if;
            end loop;
            Seen_Finishes.Clear;
        end loop;
        Finished_Token_Sort.Sort (Result);
        return V2A (Result);
    end Ambiguities;





    --  there is an isomorphism between two finished_tokens in a graph iff:
    --    - the starting and finishing points of the tokens slid along a consistent offset are equal
    --    - the enum_labels and values of the tokens are equal
    --    - there is some isomorphic match between the token_groups of each finished_token (n^2)

    --  there is an isomorphism between two token_groups iff:
    --    - the length of both groups is the same
    --    - each pair of successive finished_tokens, in order, is isomorphic

    --  should be possible to keep track of finished_tokens that are considered to be isomorphic
    --  with a finished_token -> finished_token map, and if a finished_token is encountered that is
    --  already in the map then if it matches up short circuit true

    function Group_Isomorph
           (Left_Graph        : in     Parse_Graph;
            Left_Token_Group  : in     Token_Group;
            Right_Graph       : in     Parse_Graph;
            Right_Token_Group : in     Token_Group;
            Offset            : in     Integer;
            Mapping           : in out Isomorph_Maps.Map)
        return Boolean
    is
        use type Ada.Containers.Count_Type;
    begin
        if Length (Left_Token_Group) /= Length (Right_Token_Group) then
            return False;
        end if;
        for Index in First_Index (Left_Token_Group) .. Last_Index (Left_Token_Group) loop
            if not Token_Isomorph
               (Left_Graph, Element (Left_Token_Group, Index),
                Right_Graph, Element (Right_Token_Group, Index),
                Offset, Mapping)
            then
                return False;
            end if;
        end loop;
        return True;
    end Group_Isomorph;


    function Token_Isomorph
           (Left_Graph     : in     Parse_Graph;
            Left_Position  : in     Traits.Tokens.Finished_Token_Type;
            Right_Graph    : in     Parse_Graph;
            Right_Position : in     Traits.Tokens.Finished_Token_Type;
            Offset         : in     Integer;
            Mapping        : in out Isomorph_Maps.Map)
        return Boolean
    is
        Left_Groups  : Token_Group_Array := Left_Graph.Subgroups (Left_Position);
        Right_Groups : Token_Group_Array := Right_Graph.Subgroups (Right_Position);
    begin
        if Mapping.Contains (Left_Position) and then
            Mapping.Constant_Reference (Left_Position).Contains (Right_Position)
        then
            return True;
        end if;
        if Traits.Tokens.Start (Left_Position.Token) + Offset /=
            Traits.Tokens.Start (Right_Position.Token) or else
            Left_Position.Finish + Offset /= Right_Position.Finish
        then
            return False;
        end if;
        if Traits.Tokens.Label (Left_Position.Token) /=
            Traits.Tokens.Label (Right_Position.Token) or else
            Traits.Tokens.Value (Left_Position.Token) /=
            Traits.Tokens.Value (Right_Position.Token)
        then
            return False;
        end if;
        declare
            Left_Groups  : Token_Group_Array := Left_Graph.Subgroups (Left_Position);
            Right_Groups : Token_Group_Array := Right_Graph.Subgroups (Right_Position);
        begin
            if Left_Groups'Length /= Right_Groups'Length then
                return False;
            end if;
            --  This loop only works because of the Subgroups already being sorted
            --  and any isomorphism only differing in the starts/finishes by a constant.
            for Index in Left_Groups'Range loop
                if not Group_Isomorph
                   (Left_Graph, Left_Groups (Index),
                    Right_Graph, Right_Groups (Index),
                    Offset, Mapping)
                then
                    return False;
                end if;
            end loop;
        end;
        if not Mapping.Contains (Left_Position) then
            Mapping.Insert (Left_Position, Finished_Token_Vectors.Empty_Vector);
        end if;
        Mapping.Reference (Left_Position).Append (Right_Position);
        return True;
    end Token_Isomorph;


    function Isomorphic
           (Left, Right : in Parse_Graph)
        return Boolean
    is
        use type Ada.Containers.Count_Type;
        Offset : Integer :=
            Traits.Tokens.Start (Right.Root_Elems.Element (1).Token) -
            Traits.Tokens.Start (Left.Root_Elems.Element (1).Token);
        Mapping : Isomorph_Maps.Map;
    begin
        if Left.Root_Elems.Length /= Right.Root_Elems.Length then
            return False;
        end if;
        return (for all Index in 1 .. Left.Root_Elems.Last_Index =>
            Token_Isomorph
               (Left, Left.Root_Elems (Index),
                Right, Right.Root_Elems (Index),
                Offset, Mapping));
    end Isomorphic;


    function Isomorphic_Subgraph
           (Left_Graph     : in Parse_Graph;
            Left_Position  : in Traits.Tokens.Finished_Token_Type;
            Right_Graph    : in Parse_Graph;
            Right_Position : in Traits.Tokens.Finished_Token_Type)
        return Boolean
    is
        Offset : Integer :=
            Traits.Tokens.Start (Right_Position.Token) - Traits.Tokens.Start (Left_Position.Token);
        Mapping : Isomorph_Maps.Map;
    begin
        return Token_Isomorph
           (Left_Graph, Left_Position,
            Right_Graph, Right_Position,
            Offset, Mapping);
    end Isomorphic_Subgraph;





    function To_Node
           (Container : in Parse_Graph;
            Token     : in Traits.Tokens.Token_Type)
        return Node_ID_Type is
    begin
        return Container.Label_Map.Element (Token);
    end To_Node;


    function To_Node
           (Container : in Parse_Graph;
            Position  : in Traits.Tokens.Finished_Token_Type)
        return Node_ID_Type is
    begin
        return Container.Label_Map.Element (Position.Token);
    end To_Node;





    function Sorted
           (Input : in Array_Type)
        return Boolean is
    begin
        for Index in Input'First .. Input'Last - 1 loop
            if Input (Index + 1) < Input (Index) then
                return False;
            end if;
        end loop;
        return True;
    end Sorted;


    function No_Dups
           (Input : in Array_Type)
        return Boolean is
    begin
        for X in Input'First .. Input'Last - 1 loop
            for Y in X + 1 .. Input'Last loop
                if Input (X) = Input (Y) then
                    return False;
                end if;
            end loop;
        end loop;
        return True;
    end No_Dups;


    function Vector_To_Array
           (Input : in Type_Vectors.Vector)
        return Array_Type is
    begin
        return Result : Array_Type (1 .. Input.Last_Index) do
            for I in Result'Range loop
                Result (I) := Input (I);
            end loop;
        end return;
    end Vector_To_Array;


end Packrat.Parse_Graphs;