diff options
Diffstat (limited to 'src/packrat-parse_graphs.adb')
| -rw-r--r-- | src/packrat-parse_graphs.adb | 1062 |
1 files changed, 937 insertions, 125 deletions
diff --git a/src/packrat-parse_graphs.adb b/src/packrat-parse_graphs.adb index c911fb4..c9171c6 100644 --- a/src/packrat-parse_graphs.adb +++ b/src/packrat-parse_graphs.adb @@ -1,20 +1,17 @@ -package body Packrat.Parse_Graphs is +with + -- Ada.Strings.Fixed, + Ada.Characters.Latin_1; - function "<" - (Left, Right : in Edge_Label_Type) - return Boolean is - begin - if Left.Finish = Right.Finish then - return Left.Order < Right.Order; - else - return Left.Finish < Right.Finish; - end if; - end "<"; + +package body Packrat.Parse_Graphs is + package SU renames Ada.Strings.Unbounded; + package Latin renames Ada.Characters.Latin_1; + @@ -23,47 +20,90 @@ package body Packrat.Parse_Graphs is return Boolean is use type Base.Graph; + use type Finish_Vectors.Vector; + use type Node_Label_Maps.Map; begin - return Base.Graph (Left) = Base.Graph (Right) and - Left.Root_Node = Right.Root_Node; + return Left.Internal_Graph = Right.Internal_Graph and + Left.Root_Node = Right.Root_Node and + Left.Root_Finishes = Right.Root_Finishes and + Left.Label_Map = Right.Label_Map; end "="; + function "<" + (Left, Right : Finished_Token) + return Boolean + is + Left_Index, Right_Index : Positive; + begin + if Gen_Tokens.Start (Left.Token) = Gen_Tokens.Start (Right.Token) then + if Left.Finish = Right.Finish then + if Gen_Tokens.Label (Left.Token) = Gen_Tokens.Label (Right.Token) then + Left_Index := Gen_Tokens.Value (Left.Token)'First; + Right_Index := Gen_Tokens.Value (Right.Token)'First; + while Left_Index <= Gen_Tokens.Value (Left.Token)'Last and + Right_Index <= Gen_Tokens.Value (Right.Token)'Last + loop + if Gen_Tokens.Value (Left.Token) (Left_Index) < + Gen_Tokens.Value (Right.Token) (Right_Index) + then + return True; + elsif Gen_Tokens.Value (Left.Token) (Left_Index) /= + Gen_Tokens.Value (Right.Token) (Right_Index) + then + return False; + end if; + Left_Index := Left_Index + 1; + Right_Index := Right_Index + 1; + end loop; + return Gen_Tokens.Value (Left.Token)'Length < + Gen_Tokens.Value (Right.Token)'Length; + else + return Gen_Tokens.Label (Left.Token) < Gen_Tokens.Label (Right.Token); + end if; + else + return Left.Finish < Right.Finish; + end if; + else + return Gen_Tokens.Start (Left.Token) < Gen_Tokens.Start (Right.Token); + end if; + end "<"; - - function To_Graph - (Nodes : in Node_Array; - Edges : in Edge_Array) - return Parse_Graph is + function "<" + (Left, Right : in Finished_Token_Array) + return Boolean + is + Left_Index : Positive := Left'First; + Right_Index : Positive := Right'First; begin - return G : Parse_Graph := - (Base.To_Graph (Nodes, Edges) with Root_Node => No_Node); - end To_Graph; + while Left_Index <= Left'Last and Right_Index <= Right'Last loop + if Left (Left_Index) < Right (Right_Index) then + return True; + elsif Left (Left_Index) /= Right (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 To_Graph - (Nodes : in Node_Array; - Edges : in Edge_Array; - Root : in Extended_Node_ID_Type) - return Parse_Graph - is - Valid : Boolean := False; + function "<" + (Left, Right : in Token_Group) + return Boolean is begin - if Root /= No_Node then - for N of Nodes loop - if Root = N then - Valid := True; - exit; - end if; - end loop; - if not Valid then - raise Constraint_Error with "Root node not in graph"; + if Gen_Tokens.Start (Left.Parent.Token) = Gen_Tokens.Start (Right.Parent.Token) then + if Finish (Left) = Finish (Right) then + return Left.Elems.Element < Right.Elems.Element; + else + return Finish (Left) < Finish (Right); end if; + else + return Gen_Tokens.Start (Left.Parent.Token) < Gen_Tokens.Start (Right.Parent.Token); end if; - return G : Parse_Graph := - (Base.To_Graph (Nodes, Edges) with Root_Node => Root); - end To_Graph; + end "<"; @@ -73,8 +113,10 @@ package body Packrat.Parse_Graphs is (Target : in out Parse_Graph; Source : in Parse_Graph) is begin - Base.Assign (Base.Graph (Target), Base.Graph (Source)); + Target.Internal_Graph.Assign (Source.Internal_Graph); Target.Root_Node := Source.Root_Node; + Target.Root_Finishes.Assign (Source.Root_Finishes); + Target.Label_Map.Assign (Source.Label_Map); end Assign; @@ -83,170 +125,940 @@ package body Packrat.Parse_Graphs is return Parse_Graph is begin return G : Parse_Graph := - (Base.Copy (Base.Graph (Source)) with Root_Node => Source.Root_Node); + (Internal_Graph => Source.Internal_Graph.Copy, + Root_Node => Source.Root_Node, + Root_Finishes => Source.Root_Finishes.Copy, + Label_Map => Source.Label_Map.Copy); end Copy; procedure Move (Target, Source : in out Parse_Graph) is begin - Base.Move (Base.Graph (Target), Base.Graph (Source)); + Target.Internal_Graph.Move (Source.Internal_Graph); Target.Root_Node := Source.Root_Node; - Source.Root_Node := No_Node; + Source.Root_Node := Base.No_Node; + Target.Root_Finishes.Move (Source.Root_Finishes); + Target.Label_Map.Move (Source.Label_Map); end Move; - function Root + function Is_Empty (Container : in Parse_Graph) - return Cursor is + return Boolean is begin - if not Container.Contains (Container.Root_Node) then - return No_Element; - else - return Container.To_Cursor (Container.Root_Node); - end if; - end Root; + return Container.Label_Map.Is_Empty; + end Is_Empty; - procedure Set_Root - (Container : in out Parse_Graph; - Node : in Extended_Node_ID_Type) is + procedure Clear + (Container : in out Parse_Graph) is begin - Container.Root_Node := Node; - end Set_Root; + Container.Internal_Graph.Clear; + Container.Root_Node := Base.No_Node; + Container.Root_Finishes.Clear; + Container.Label_Map.Clear; + end Clear; - function Finish_List + function In_Finishes (Container : in Parse_Graph; Node : in Node_ID_Type) - return Finish_Array is + return Finish_Vectors.Vector + is + Result : Finish_Vectors.Vector; + Current : Finish_Type; begin - return Finish_List (Container.To_Cursor (Node)); - end Finish_List; + if Node = Container.Root_Node then + Result := Container.Root_Finishes; + end if; + 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 Finish_List - (Position : in Cursor) - return Finish_Array + function Out_Finishes + (Container : in Parse_Graph; + Node : in Node_ID_Type) + return Finish_Vectors.Vector is - function V2A is new Vector_To_Array (Finish_Type, Finish_Array, Finish_Vectors); - Fins : Finish_Vectors.Vector; - Current : Edge_Label_Type; - begin - for E of Outbound (Position) loop - if Has_Label (Position, E) then - Current := Label (Position, E); - if not Fins.Contains (Current.Finish) then - Fins.Append (Current.Finish); - end if; + Result : Finish_Vectors.Vector; + Current : Finish_Type; + begin + for Edge of Container.Internal_Graph.Outbound (Node) loop + Current := Container.Internal_Graph.Label (Edge).Group_Finish; + if not Result.Contains (Current) then + Result.Append (Current); end if; end loop; - Finsort.Sort (Fins); - return V2A (Fins); - end Finish_List; + return Result; + end Out_Finishes; + + + + + + function Debug_String + (Container : in Parse_Graph) + return String + is + Mapping : Enum_Node_Maps.Map; + Current : Gen_Tokens.Token; + Result : SU.Unbounded_String; + begin + for Node of Container.Internal_Graph.Nodes loop + declare + Current : Label_Enum := + Gen_Tokens.Label (Container.Internal_Graph.Label (Node)); + begin + if not Mapping.Contains (Current) then + Mapping.Insert (Current, Node_Vectors.Empty_Vector); + end if; + Mapping.Reference (Current).Append (Node); + end; + end loop; + for Iter in Mapping.Iterate loop + SU.Append (Result, Label_Enum'Image (Enum_Node_Maps.Key (Iter)) & Latin.HT); + for Node of Enum_Node_Maps.Element (Iter) loop + Current := Container.Internal_Graph.Label (Node); + SU.Append (Result, Positive'Image (Gen_Tokens.Start (Current)) & " ->" & Latin.HT); + for Fin of In_Finishes (Container, Node) loop + SU.Append (Result, Finish_Type'Image (Fin) & " ->" & Latin.HT); + declare + Groupings : Token_Group_Array := Container.Subgroups ((Current, Fin)); + begin + if Groupings'Length = 0 then + SU.Append (Result, "Leaf"); + else + for Grouping of Groupings loop + for Fin_Token of Elements (Grouping) loop + SU.Append (Result, "Subnode " & + Label_Enum'Image (Gen_Tokens.Label (Fin_Token.Token)) & + " (" & Positive'Image (Gen_Tokens.Start (Fin_Token.Token)) & + "," & Finish_Type'Image (Fin_Token.Finish) & "), "); + end loop; + SU.Delete (Result, SU.Length (Result) - 1, SU.Length (Result)); + SU.Append (Result, Latin.HT); + SU.Append (Result, SU."*" (3, 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; + -- what delete goes here? + end loop; + return SU.To_String (Result); + end Debug_String; + - function Sub_Nodes + + + function Contains (Container : in Parse_Graph; - Node : in Node_ID_Type; - Finish_At : in Finish_Type) - return Node_Array is + Token : in Gen_Tokens.Token) + return Boolean is begin - return Sub_Nodes (Container.To_Cursor (Node), Finish_At); - end Sub_Nodes; + return Container.Label_Map.Contains (Token); + end Contains; - function Sub_Nodes - (Position : in Cursor; - Finish_At : in Finish_Type) - return Node_Array + function Contains + (Container : in Parse_Graph; + Position : in Finished_Token) + return Boolean is - function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors); - Nodes : Node_Vectors.Vector; - Current_Label : Edge_Label_Type; - begin - for E of Outbound (Position) loop - if Has_Label (Position, E) then - Current_Label := Label (Position, E); - if Current_Label.Finish = Finish_At then - Nodes.Reference (Current_Label.Order) := E.To; + Node : Node_ID_Type; + begin + if not Container.Contains (Position.Token) then + return False; + end if; + Node := Container.Label_Map.Element (Position.Token); + if Node = Container.Root_Node then + for F of Container.Root_Finish_List loop + if F = Position.Finish then + return True; end if; + end loop; + end if; + 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 + Groups : Group_ID_Vectors.Vector; + Next_ID : Group_ID_Type; + Parent_Node : Node_ID_Type; + begin + if not Container.Contains (Grouping.Parent) then + return False; + end if; + for Fin_Token of Elements (Grouping) loop + if not Container.Contains (Fin_Token) then + return False; + end if; + end loop; + Parent_Node := Container.Label_Map.Element (Grouping.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 V2A (Nodes); - end Sub_Nodes; + return (for some ID of Groups => + (for all Sub of Elements (Grouping) => + (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 => Finish (Grouping), + Subnode_Finish => Sub.Finish)))); + end Contains; + + + function Reachable + (Container : in Parse_Graph; + Position : in Finished_Token) + return Boolean + is + -- This is basically a depth first search function. + function Finder + (Current : in Finished_Token) + return Boolean is + 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 Finish of Container.Root_Finish_List => + Finder (Container.Root_Element (Finish))); + end Reachable; + + + function Locally_Reachable + (Container : in Parse_Graph; + Node : in Node_ID_Type) + return Boolean + is + use type Ada.Containers.Count_Type; + In_Subnodes, Out_Groups : Finish_Vectors.Vector; + In_Pos, Out_Pos : Positive := 1; + begin + In_Subnodes := In_Finishes (Container, Node); + if In_Subnodes.Length = 0 then + return False; + end if; + Out_Groups := Out_Finishes (Container, Node); + Finish_Sort.Sort (In_Subnodes); + Finish_Sort.Sort (Out_Groups); + while Out_Pos <= Out_Groups.Last_Index loop + if In_Pos > In_Subnodes.Last_Index or else + In_Subnodes.Element (In_Pos) > Out_Groups.Element (Out_Pos) + then + return False; + elsif In_Subnodes.Element (In_Pos) = Out_Groups.Element (Out_Pos) then + Out_Pos := Out_Pos + 1; + end if; + In_Pos := In_Pos + 1; + end loop; + return True; + end Locally_Reachable; + + + function All_Reachable + (Container : in Parse_Graph) + return Boolean is + begin + return (for all Node of Container.Internal_Graph.Nodes => + Container.Locally_Reachable (Node)); + end All_Reachable; + + + function Valid_Starts_Finishes + (Parent : in Finished_Token; + Subtokens : in Finished_Token_Array) + return Boolean + is + Subvec : Finished_Token_Vectors.Vector; + begin + for Sub of Subtokens loop + if Gen_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 >= Gen_Tokens.Start (Subvec (Index + 1).Token) then + return False; + end if; + end loop; + if Parent.Finish < Subvec.Last_Element.Finish or else + Gen_Tokens.Start (Parent.Token) > Gen_Tokens.Start (Subvec.First_Element.Token) + then + return False; + end if; + return True; + end Valid_Starts_Finishes; + + + function No_Loops_Introduced + (Container : in Parse_Graph; + Parent : in Finished_Token; + Subtokens : in Finished_Token_Array) + return Boolean + is + function Looper + (Current : in Finished_Token) + return Boolean is + begin + if not Container.Contains (Current.Token) then + return False; + elsif Current = Parent then + return True; + elsif Gen_Tokens.Start (Current.Token) > Gen_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 not Container.Contains (Parent.Token) or else + (for all Sub of Subtokens => not Looper (Sub)); + end No_Loops_Introduced; + + + function Is_Sorted + (Finishes : in Finish_Array) + return Boolean + is + function Actual is new Sorted (Finish_Type, Finish_Array); + begin + return Actual (Finishes); + end Is_Sorted; + + + function Is_Sorted + (Positions : in Finished_Token_Array) + return Boolean + is + function Actual is new Sorted (Finished_Token, Finished_Token_Array); + 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 Finish_Array) + return Boolean + is + function Actual is new No_Dups (Finish_Type, Finish_Array); + begin + return Actual (Finishes); + end No_Duplicates; + + + function No_Duplicates + (Positions : in Finished_Token_Array) + return Boolean + is + function Actual is new No_Dups (Finished_Token, Finished_Token_Array); + 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 Gen_Tokens.Token) + 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 Finished_Token; + Subtokens : in 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 + 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; - Node : in Node_ID_Type) + Token : in Gen_Tokens.Token) is + begin + if not Container.Contains (Token) then + return; + end if; + if Container.Label_Map (Token) = Container.Root_Node then + Container.Clear_Root; + end if; + Container.Internal_Graph.Delete (Container.Label_Map (Token)); + Container.Label_Map.Delete (Token); + end Prune; + + + procedure Prune + (Container : in out Parse_Graph; + Position : in Finished_Token) is - My_Cursor : Cursor := Container.To_Cursor (Node); + Node : Node_ID_Type; begin - Prune (My_Cursor); + if not Container.Contains (Position.Token) then + return; + end if; + Node := Container.Label_Map.Element (Position.Token); + if Node = Container.Root_Node then + for I in reverse 1 .. Container.Root_Finishes.Last_Index loop + if Container.Root_Finishes.Element (I) = Position.Finish then + Container.Root_Finishes.Delete (I); + end if; + end loop; + end if; + 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 - (Position : in out Cursor) + (Container : in out Parse_Graph; + Grouping : in Token_Group) is - use type Ada.Containers.Count_Type; - Active : Cursor_Vectors.Vector; - Current : Cursor; + Group_IDs : Group_ID_Vectors.Vector; + Parent_Node : Node_ID_Type; + Current_ID : Group_ID_Type; begin - if not Has_Element (Position) then + -- Short circuit checks + if not Container.Contains (Grouping.Parent) then return; end if; - for N of Children (Position) loop - if N /= Element (Position) then - Active.Append (Cursor_To (Position, N)); + for Fin_Token of Elements (Grouping) loop + if not Container.Contains (Fin_Token) then + return; end if; end loop; - Delete (Position); - while not Active.Is_Empty loop - for Index in reverse 1 .. Active.Last_Index loop - Current := Active (Index); - if Indegree (Current) = 0 then - for N of Children (Current) loop - if not Active.Contains (Cursor_To (Current, N)) then - Active.Append (Cursor_To (Current, N)); - end if; - end loop; - Delete (Current); + + 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; - Active.Delete (Index); 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) and then + 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); + end if; + end loop; + Examine.Move (Next); + end loop; + end Delete_Unreachable; - function Is_Ambiguous + + + function Has_Root (Container : in Parse_Graph) return Boolean is begin - for N of Container.Nodes loop - if Finish_List (Container, N)'Length > 1 then - return True; + return Container.Root_Node /= Base.No_Node; + end Has_Root; + + + procedure Set_Root + (Container : in out Parse_Graph; + Token : in Gen_Tokens.Token; + Finishes : in Finish_Array) is + begin + Container.Root_Node := Container.Label_Map.Element (Token); + Container.Root_Finishes.Clear; + for F of Finishes loop + if not Container.Root_Finishes.Contains (F) then + Container.Root_Finishes.Append (F); + end if; + end loop; + Finish_Sort.Sort (Container.Root_Finishes); + end Set_Root; + + + procedure Clear_Root + (Container : in out Parse_Graph) is + begin + Container.Root_Node := Base.No_Node; + Container.Root_Finishes.Clear; + end Clear_Root; + + + function Root_Token + (Container : in Parse_Graph) + return Gen_Tokens.Token is + begin + return Container.Internal_Graph.Label (Container.Root_Node); + end Root_Token; + + + function Root_Finish_List + (Container : in Parse_Graph) + return Finish_Array + is + function V2A is new Vector_To_Array (Finish_Type, Finish_Array, Finish_Vectors); + begin + return V2A (Container.Root_Finishes); + end Root_Finish_List; + + + function Root_Element + (Container : in Parse_Graph; + Finish_At : in Finish_Type) + return Finished_Token is + begin + return Root : Finished_Token := + (Token => Container.Internal_Graph.Label (Container.Root_Node), + Finish => Finish_At); + end Root_Element; + + + + + + function Finish_List + (Container : in Parse_Graph; + Token : in Gen_Tokens.Token) + return Finish_Array + is + function V2A is new Vector_To_Array (Finish_Type, Finish_Array, Finish_Vectors); + Result : Finish_Vectors.Vector; + begin + 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 Finished_Token) + 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 Finished_Token) + return Boolean is + begin + return not Container.Is_Leaf (Position); + end Is_Branch; + + + + + + function Subgroups + (Container : in Parse_Graph; + Position : in Finished_Token) + return Token_Group_Array + is + function V2A is new Vector_To_Array + (Finished_Token, Finished_Token_Array, Finished_Token_Vectors); + 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 : Finished_Token; + 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 => Finished_Token_Array_Holders.To_Holder (V2A (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.Constant_Reference.Element'First; + end First_Index; + + + function Last_Index + (Grouping : in Token_Group) + return Positive is + begin + return Grouping.Elems.Constant_Reference.Element'Last; + end Last_Index; + + + function Length + (Grouping : in Token_Group) + return Ada.Containers.Count_Type is + begin + return Ada.Containers.Count_Type + (Grouping.Elems.Constant_Reference.Element'Length); + end Length; + + + function Element + (Grouping : in Token_Group; + Index : in Positive) + return Finished_Token is + begin + return Grouping.Elems.Constant_Reference.Element (Index); + end Element; + + + function Elements + (Grouping : in Token_Group) + return Finished_Token_Array is + begin + return Grouping.Elems.Element; + end Elements; + + + function Parent + (Grouping : in Token_Group) + return Finished_Token is + begin + return Grouping.Parent; + end Parent; + + + function Finish + (Grouping : in Token_Group) + return 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; + First_Group : Group_ID_Type; + Seen_Group : Boolean := False; + Check_Label : Edge_Label_Type; + begin + if Container.Root_Finishes.Length = 0 then + return False; + elsif Container.Root_Finishes.Length > 1 then + return True; + end if; + for Edge of Container.Internal_Graph.Outbound (Container.Root_Node) loop + Check_Label := Container.Internal_Graph.Label (Edge); + if Container.Root_Finishes.Contains (Check_Label.Group_Finish) then + if not Seen_Group then + Seen_Group := True; + First_Group := Check_Label.Group_ID; + elsif Check_Label.Group_ID /= First_Group then + return True; + end if; end if; end loop; return False; + 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 Finished_Token_Array + is + function V2A is new Vector_To_Array + (Finished_Token, Finished_Token_Array, Finished_Token_Vectors); + Seen_Finishes : Finish_Group_Maps.Map; + Edge_Label : Edge_Label_Type; + Next_Token : Finished_Token; + 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; + + + + + + function Isomorphic + (Left, Right : in Parse_Graph) + return Boolean + is + begin + -- to-do + return False; + end Isomorphic; + + + function Isomorphic_Subgraph + (Left_Graph : in Parse_Graph; + Left_Position : in Finished_Token; + Right_Graph : in Parse_Graph; + Right_Position : in Finished_Token) + return Boolean + is + begin + -- to-do + return False; + end Isomorphic_Subgraph; + + + + function To_Node + (Container : in Parse_Graph; + Token : in Gen_Tokens.Token) + return Node_ID_Type is + begin + return Container.Label_Map.Element (Token); + end To_Node; + + + function To_Node + (Container : in Parse_Graph; + Position : in Finished_Token) + 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) |