diff options
| -rw-r--r-- | src/packrat-parse_graphs.adb | 93 | ||||
| -rw-r--r-- | src/packrat-parse_graphs.ads | 30 |
2 files changed, 65 insertions, 58 deletions
diff --git a/src/packrat-parse_graphs.adb b/src/packrat-parse_graphs.adb index 49ca752..7d2d62f 100644 --- a/src/packrat-parse_graphs.adb +++ b/src/packrat-parse_graphs.adb @@ -153,24 +153,6 @@ package body Packrat.Parse_Graphs is end In_Finishes; - function Out_Finishes - (Container : in Parse_Graph; - Node : in Node_ID_Type) - return Finish_Vectors.Vector - is - Result : Finish_Vectors.Vector; - Current : Traits.Tokens.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; - return Result; - end Out_Finishes; - - @@ -245,7 +227,9 @@ package body Packrat.Parse_Graphs is SU.Delete (Result, SU.Length (Result), SU.Length (Result)); SU.Append (Result, Latin.LF & Latin.LF); end loop; - SU.Delete (Result, SU.Length (Result) - 1, SU.Length (Result)); + 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; @@ -360,36 +344,50 @@ package body Packrat.Parse_Graphs is 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; + for Fin_Token of Container.Root_Elems loop + if Container.Label_Map.Element (Fin_Token.Token) = Node then + return True; end if; - In_Pos := In_Pos + 1; end loop; - return True; + 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 => - Container.Locally_Reachable (Node)); + Locally_Reachable (Container, Node) and + Unreachable_Outbound (Container, Node)'Length = 0); end All_Reachable; @@ -685,13 +683,18 @@ package body Packrat.Parse_Graphs is 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); + 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); diff --git a/src/packrat-parse_graphs.ads b/src/packrat-parse_graphs.ads index e13bfc7..b302004 100644 --- a/src/packrat-parse_graphs.ads +++ b/src/packrat-parse_graphs.ads @@ -335,6 +335,19 @@ private + -- This 'use type' is to avoid some ambiguities with "=" functions when + -- instantiating the Base package. + use type Traits.Tokens.Token_Type; + + package Base is new Directed_Graphs + (Node_ID_Type => Node_ID_Type, + Edge_ID_Type => Edge_ID_Type, + Node_Label_Type => Node_Label_Type, + Edge_Label_Type => Edge_Label_Type); + + + + function To_Node (Container : in Parse_Graph; Token : in Traits.Tokens.Token_Type) @@ -350,19 +363,10 @@ private Node : in Node_ID_Type) return Boolean; - - - - -- This 'use type' is to avoid some ambiguities with "=" functions when - -- instantiating the Base package. - use type Traits.Tokens.Token_Type; - - package Base is new Directed_Graphs - (Node_ID_Type => Node_ID_Type, - Edge_ID_Type => Edge_ID_Type, - Node_Label_Type => Node_Label_Type, - Edge_Label_Type => Edge_Label_Type); - + function Unreachable_Outbound + (Container : in Parse_Graph; + Node : in Node_ID_Type) + return Base.Edge_Array; |