Bugfixes, esp Delete_Unreachable

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;