summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2020-12-13 23:22:31 +1100
committerJed Barber <jjbarber@y7mail.com>2020-12-13 23:22:31 +1100
commit88b57c216a6ac2f1565686a66448c155f571852c (patch)
tree4df26d3f2ccb7ccac66fc45a81ad840c2cbc038b /src
parent8834bc154280e443aeac618eb433e365d82253c6 (diff)
Bugfixes, esp Delete_Unreachable
Diffstat (limited to 'src')
-rw-r--r--src/packrat-parse_graphs.adb93
-rw-r--r--src/packrat-parse_graphs.ads30
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;