summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2020-05-22 22:23:22 +1000
committerJed Barber <jjbarber@y7mail.com>2020-05-22 22:23:22 +1000
commit853a5a484f3e556a526473f23a60e3394b133abe (patch)
treead8adc696da663d22b6d6821e357f6ec70fa51ab
parentb586137f3475d5eb1fcfde2ba2f6b74e7c564cef (diff)
Parse_Graphs complete but untested
-rw-r--r--packrat.gpr3
-rw-r--r--src/packrat-parse_graphs.adb249
-rw-r--r--src/packrat-parse_graphs.ads556
3 files changed, 808 insertions, 0 deletions
diff --git a/packrat.gpr b/packrat.gpr
index 6864f2c..c66f654 100644
--- a/packrat.gpr
+++ b/packrat.gpr
@@ -1,5 +1,8 @@
+with "directed_graph";
+
+
library project Packrat is
diff --git a/src/packrat-parse_graphs.adb b/src/packrat-parse_graphs.adb
new file mode 100644
index 0000000..16b74dc
--- /dev/null
+++ b/src/packrat-parse_graphs.adb
@@ -0,0 +1,249 @@
+
+
+package body Packrat.Parse_Graphs is
+
+
+ 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 "<";
+
+
+
+
+
+ function "="
+ (Left, Right : in Parse_Graph)
+ return Boolean
+ is
+ use type Base.Graph;
+ begin
+ return Base.Graph (Left) = Base.Graph (Right) and
+ Left.Root_Node = Right.Root_Node;
+ end "=";
+
+
+
+
+
+ function To_Graph
+ (Nodes : in Node_Array;
+ Edges : in Edge_Array)
+ return Parse_Graph is
+ begin
+ return G : Parse_Graph :=
+ (Base.To_Graph (Nodes, Edges) with Root_Node => No_Node);
+ end To_Graph;
+
+
+ function To_Graph
+ (Nodes : in Node_Array;
+ Edges : in Edge_Array;
+ Root : in Extended_Node_ID_Type)
+ return Parse_Graph
+ is
+ Valid : Boolean := False;
+ 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";
+ end if;
+ end if;
+ return G : Parse_Graph :=
+ (Base.To_Graph (Nodes, Edges) with Root_Node => Root);
+ end To_Graph;
+
+
+
+
+
+ procedure Assign
+ (Target : in out Parse_Graph;
+ Source : in Parse_Graph) is
+ begin
+ Base.Assign (Base.Graph (Target), Base.Graph (Source));
+ Target.Root_Node := Source.Root_Node;
+ end Assign;
+
+
+ function Copy
+ (Source : in Parse_Graph)
+ return Parse_Graph is
+ begin
+ return G : Parse_Graph :=
+ (Base.Copy (Base.Graph (Source)) with Root_Node => Source.Root_Node);
+ end Copy;
+
+
+ procedure Move
+ (Target, Source : in out Parse_Graph) is
+ begin
+ Base.Move (Base.Graph (Target), Base.Graph (Source));
+ Target.Root_Node := Source.Root_Node;
+ Source.Root_Node := No_Node;
+ end Move;
+
+
+
+
+
+ function Root
+ (Container : in Parse_Graph)
+ return Cursor 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;
+
+
+ procedure Set_Root
+ (Container : in out Parse_Graph;
+ Node : in Extended_Node_ID_Type) is
+ begin
+ Container.Root_Node := Node;
+ end Set_Root;
+
+
+
+
+
+ function Finish_List
+ (Container : in Parse_Graph;
+ Node : in Node_ID_Type)
+ return Finish_Array is
+ begin
+ return Finish_List (Container.To_Cursor (Node));
+ end Finish_List;
+
+
+ function Finish_List
+ (Position : in Cursor)
+ return Finish_Array
+ 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;
+ end if;
+ end loop;
+ Finsort.Sort (Fins);
+ return V2A (Fins);
+ end Finish_List;
+
+
+ function Sub_Nodes
+ (Container : in Parse_Graph;
+ Node : in Node_ID_Type;
+ Finish_At : in Finish_Type)
+ return Node_Array is
+ begin
+ return Sub_Nodes (Container.To_Cursor (Node), Finish_At);
+ end Sub_Nodes;
+
+
+ function Sub_Nodes
+ (Position : in Cursor;
+ Finish_At : in Finish_Type)
+ return Node_Array
+ 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;
+ end if;
+ end if;
+ end loop;
+ return V2A (Nodes);
+ end Sub_Nodes;
+
+
+
+
+
+ procedure Prune
+ (Container : in out Parse_Graph;
+ Node : in Node_ID_Type)
+ is
+ My_Cursor : Cursor := Container.To_Cursor (Node);
+ begin
+ Prune (My_Cursor);
+ end Prune;
+
+
+ procedure Prune
+ (Position : in out Cursor)
+ is
+ use type Ada.Containers.Count_Type;
+ Active : Cursor_Vectors.Vector;
+ Current : Cursor;
+ begin
+ if not Has_Element (Position) then
+ return;
+ end if;
+ for N of Children (Position) loop
+ if N /= Element (Position) then
+ Active.Append (Cursor_To (Position, N));
+ 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);
+ end if;
+ Active.Delete (Index);
+ end loop;
+ end loop;
+ end Prune;
+
+
+
+
+
+ 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;
+
+
diff --git a/src/packrat-parse_graphs.ads b/src/packrat-parse_graphs.ads
new file mode 100644
index 0000000..0a3660e
--- /dev/null
+++ b/src/packrat-parse_graphs.ads
@@ -0,0 +1,556 @@
+
+
+with
+
+ Ada.Containers,
+ Directed_Graphs;
+
+private with
+
+ Ada.Containers.Vectors;
+
+
+generic
+
+ type Label_Enum is (<>);
+ type Element_Type is private;
+ type Element_Array is array (Positive range <>) of Element_Type;
+
+ with package Gen_Tokens is new Tokens (Label_Enum, Element_Type, Element_Array);
+
+package Packrat.Parse_Graphs is
+
+
+ type Node_ID_Type is new Positive;
+ type Edge_ID_Type is new Positive;
+
+ subtype Node_Label_Type is Gen_Tokens.Token;
+
+ subtype Finish_Type is Positive;
+ subtype Order_Type is Positive;
+ type Edge_Label_Type is record
+ Finish : Finish_Type;
+ Order : Order_Type;
+ end record;
+
+ function "<"
+ (Left, Right : in Edge_Label_Type)
+ return Boolean;
+
+ type Finish_Array is array (Positive range <>) of Finish_Type;
+
+
+
+
+ -- This is to avoid some... ambiguities... with "="
+ -- functions when instantiating the Base package.
+ use type Gen_Tokens.Token;
+
+ 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);
+
+ subtype Extended_Node_ID_Type is Base.Extended_Node_ID_Type;
+ subtype Node_Array is Base.Node_Array;
+ subtype Path is Base.Path;
+
+ subtype Edge_Type is Base.Edge_Type;
+ subtype Edge_Array is Base.Edge_Array;
+
+ function "<"
+ (Left, Right : in Edge_Type)
+ return Boolean
+ renames Base."<";
+
+
+
+
+ subtype Node_Label_Constant_Reference is Base.Node_Label_Constant_Reference;
+ subtype Node_Label_Reference is Base.Node_Label_Reference;
+ subtype Edge_Label_Constant_Reference is Base.Edge_Label_Constant_Reference;
+ subtype Edge_Label_Reference is Base.Edge_Label_Reference;
+
+
+
+
+ type Parse_Graph is new Base.Graph with private;
+ subtype Cursor is Base.Cursor;
+
+ function "="
+ (Left, Right : in Cursor)
+ return Boolean
+ renames Base."=";
+
+ function "="
+ (Left, Right : in Parse_Graph)
+ return Boolean;
+
+
+
+
+ No_Node : constant Extended_Node_ID_Type := Base.No_Node;
+ No_Element : constant Cursor := Base.No_Element;
+ Empty_Graph : constant Parse_Graph;
+
+
+
+
+ function To_Graph
+ (Nodes : in Node_Array;
+ Edges : in Edge_Array)
+ return Parse_Graph;
+
+ function To_Graph
+ (Nodes : in Node_Array;
+ Edges : in Edge_Array;
+ Root : in Extended_Node_ID_Type)
+ return Parse_Graph;
+
+
+
+
+ procedure Assign
+ (Target : in out Parse_Graph;
+ Source : in Parse_Graph);
+
+ function Copy
+ (Source : in Parse_Graph)
+ return Parse_Graph;
+
+ procedure Move
+ (Target, Source : in out Parse_Graph);
+
+
+
+
+ -- Usually you would get a Parse_Graph by way of parsing something
+ -- with the parser, which would then have a root node already set,
+ -- being the only node in the graph that has no parents.
+ function Root
+ (Container : in Parse_Graph)
+ return Cursor;
+
+ -- Not really advisable under most circumstances unless you're
+ -- making a Parse_Graph manually for some reason.
+ procedure Set_Root
+ (Container : in out Parse_Graph;
+ Node : in Extended_Node_ID_Type);
+
+
+
+
+ -- Returns an array of the all possible finish positions resulting
+ -- from current node's parsing, sorted from shortest to longest.
+ function Finish_List
+ (Container : in Parse_Graph;
+ Node : in Node_ID_Type)
+ return Finish_Array;
+
+ function Finish_List
+ (Position : in Cursor)
+ return Finish_Array;
+
+ -- Returns an array of children of a node made by a parse that ended
+ -- at a specified finish position, sorted according to parsing order.
+ function Sub_Nodes
+ (Container : in Parse_Graph;
+ Node : in Node_ID_Type;
+ Finish_At : in Finish_Type)
+ return Node_Array;
+
+ function Sub_Nodes
+ (Position : in Cursor;
+ Finish_At : in Finish_Type)
+ return Node_Array;
+
+
+
+
+ -- Deletes a node from the graph then removes any other nodes that
+ -- were made unreachable from the root by that deletion.
+ procedure Prune
+ (Container : in out Parse_Graph;
+ Node : in Node_ID_Type);
+
+ procedure Prune
+ (Position : in out Cursor);
+
+
+
+
+ -- Since this package sets the Nodes, Edges, and Labels of the Graphs
+ -- to be specific types, it cannot be a child package of Directed_Graphs.
+ -- Yet, it still is an extension of that package. To make it all work
+ -- conveniently we re-export all the Cursor functions and procedures here.
+ -- The Graph functions and procedures can be called with dot extension
+ -- notation regardless so aren't a concern.
+
+ function Has_Element
+ (Position : in Cursor)
+ return Boolean
+ renames Base.Has_Element;
+
+ function Element
+ (Position : in Cursor)
+ return Extended_Node_ID_Type
+ renames Base.Element;
+
+ function Node_Count
+ (Container : in Cursor)
+ return Ada.Containers.Count_Type
+ renames Base.Node_Count;
+
+ function Node_Count_In_Subgraph
+ (Position : in Cursor)
+ return Ada.Containers.Count_Type
+ renames Base.Node_Count_In_Subgraph;
+
+ function Edge_Count
+ (Container : in Cursor)
+ return Ada.Containers.Count_Type
+ renames Base.Edge_Count;
+
+ function Edge_Count_In_Subgraph
+ (Position : in Cursor)
+ return Ada.Containers.Count_Type
+ renames Base.Edge_Count_In_Subgraph;
+
+ function Nodes
+ (Container : in Cursor)
+ return Node_Array
+ renames Base.Nodes;
+
+ function Nodes_In_Subgraph
+ (Position : in Cursor)
+ return Node_Array
+ renames Base.Nodes_In_Subgraph;
+
+ function Edges
+ (Container : in Cursor)
+ return Edge_Array
+ renames Base.Edges;
+
+ function Edges_In_Subgraph
+ (Position : in Cursor)
+ return Edge_Array
+ renames Base.Edges_In_Subgraph;
+
+ function Unused
+ (Container : in Cursor)
+ return Node_ID_Type
+ renames Base.Unused;
+
+ function Unused
+ (Container : in Cursor)
+ return Edge_ID_Type
+ renames Base.Unused;
+
+ procedure Insert
+ (Container : in Cursor;
+ Node : in Node_ID_Type)
+ renames Base.Insert;
+
+ procedure Insert
+ (Container : in Cursor;
+ Node : in Node_ID_Type;
+ Label : in Node_Label_Type)
+ renames Base.Insert;
+
+ procedure Insert
+ (Container : in Cursor;
+ Edge : in Edge_Type)
+ renames Base.Insert;
+
+ procedure Insert
+ (Container : in Cursor;
+ Edge : in Edge_Type;
+ Label : in Edge_Label_Type)
+ renames Base.Insert;
+
+ procedure Delete
+ (Position : in out Cursor)
+ renames Base.Delete;
+
+ procedure Delete
+ (Container : in Cursor;
+ Edge : in Edge_Type)
+ renames Base.Delete;
+
+ procedure Append_Label
+ (Position : in Cursor;
+ Label : in Node_Label_Type)
+ renames Base.Append_Label;
+
+ procedure Append_Label
+ (Container : in Cursor;
+ Edge : in Edge_Type;
+ Label : in Edge_Label_Type)
+ renames Base.Append_Label;
+
+ procedure Replace_Label
+ (Position : in Cursor;
+ Label : in Node_Label_Type)
+ renames Base.Replace_Label;
+
+ procedure Replace_Label
+ (Container : in Cursor;
+ Edge : in Edge_Type;
+ Label : in Edge_Label_Type)
+ renames Base.Replace_Label;
+
+ procedure Delete_Label
+ (Position : in Cursor)
+ renames Base.Delete_Label;
+
+ procedure Delete_Label
+ (Container : in Cursor;
+ Edge : in Edge_Type)
+ renames Base.Delete_Label;
+
+ procedure Delete_Subgraph
+ (Position : in out Cursor)
+ renames Base.Delete_Subgraph;
+
+ procedure Swap
+ (Left, Right : in out Cursor)
+ renames Base.Swap;
+
+ function Constant_Label_Reference
+ (Position : in Cursor)
+ return Node_Label_Constant_Reference
+ renames Base.Constant_Label_Reference;
+
+ function Label_Reference
+ (Position : in Cursor)
+ return Node_Label_Reference
+ renames Base.Label_Reference;
+
+ function Constant_Label_Reference
+ (Container : in Cursor;
+ Edge : in Edge_Type)
+ return Edge_Label_Constant_Reference
+ renames Base.Constant_Label_Reference;
+
+ function Label_Reference
+ (Container : in Cursor;
+ Edge : in Edge_Type)
+ return Edge_Label_Reference
+ renames Base.Label_Reference;
+
+ function Has_Label
+ (Position : in Cursor)
+ return Boolean
+ renames Base.Has_Label;
+
+ function Has_Label
+ (Container : in Cursor;
+ Edge : in Edge_Type)
+ return Boolean
+ renames Base.Has_Label;
+
+ function Label
+ (Position : in Cursor)
+ return Node_Label_Type
+ renames Base.Label;
+
+ function Label
+ (Container : in Cursor;
+ Edge : in Edge_Type)
+ return Edge_Label_Type
+ renames Base.Label;
+
+ function Neighbors
+ (Position : in Cursor)
+ return Node_Array
+ renames Base.Neighbors;
+
+ function Parents
+ (Position : in Cursor)
+ return Node_Array
+ renames Base.Parents;
+
+ function Children
+ (Position : in Cursor)
+ return Node_Array
+ renames Base.Children;
+
+ function Outbound
+ (Position : in Cursor)
+ return Edge_Array
+ renames Base.Outbound;
+
+ function Inbound
+ (Position : in Cursor)
+ return Edge_Array
+ renames Base.Inbound;
+
+ function Between
+ (Parent, Child : in Cursor)
+ return Edge_Array
+ renames Base.Between;
+
+ function Outdegree
+ (Position : in Cursor)
+ return Ada.Containers.Count_Type
+ renames Base.Outdegree;
+
+ function Indegree
+ (Position : in Cursor)
+ return Ada.Containers.Count_Type
+ renames Base.Indegree;
+
+ function Degree
+ (Position : in Cursor)
+ return Ada.Containers.Count_Type
+ renames Base.Degree;
+
+ function Has_Edge
+ (Parent, Child : in Cursor)
+ return Boolean
+ renames Base.Has_Edge;
+
+ function Has_Labeled_Edge
+ (Parent, Child : in Cursor)
+ return Boolean
+ renames Base.Has_Labeled_Edge;
+
+ function Has_Neighbor
+ (Left, Right : in Cursor)
+ return Boolean
+ renames Base.Has_Neighbor;
+
+ function Find_In_Subgraph
+ (Position : in Cursor;
+ Label : in Node_Label_Type)
+ return Node_Array
+ renames Base.Find_In_Subgraph;
+
+ function Find_In_Subgraph
+ (Position : in Cursor;
+ Label : in Edge_Label_Type)
+ return Edge_Array
+ renames Base.Find_In_Subgraph;
+
+ function Contains_In_Subgraph
+ (Position : in Cursor;
+ Node : in Extended_Node_ID_Type)
+ return Boolean
+ renames Base.Contains_In_Subgraph;
+
+ function Contains_In_Subgraph
+ (Position : in Cursor;
+ Node : in Extended_Node_ID_Type;
+ Label : in Node_Label_Type)
+ return Boolean
+ renames Base.Contains_In_Subgraph;
+
+ function Contains_In_Subgraph
+ (Position : in Cursor;
+ Edge_ID : in Edge_ID_Type)
+ return Boolean
+ renames Base.Contains_In_Subgraph;
+
+ function Contains_In_Subgraph
+ (Position : in Cursor;
+ Edge : in Edge_Type)
+ return Boolean
+ renames Base.Contains_In_Subgraph;
+
+ function Contains_In_Subgraph
+ (Position : in Cursor;
+ Edge : in Edge_Type;
+ Label : in Edge_Label_Type)
+ return Boolean
+ renames Base.Contains_In_Subgraph;
+
+ function Contains_Label_In_Subgraph
+ (Position : in Cursor;
+ Label : in Node_Label_Type)
+ return Boolean
+ renames Base.Contains_Label_In_Subgraph;
+
+ function Contains_Label_In_Subgraph
+ (Position : in Cursor;
+ Label : in Edge_Label_Type)
+ return Boolean
+ renames Base.Contains_Label_In_Subgraph;
+
+ function Next
+ (Position : in Cursor)
+ return Cursor
+ renames Base.Next;
+
+ procedure Next
+ (Position : in out Cursor)
+ renames Base.Next;
+
+ function Previous
+ (Position : in Cursor)
+ return Cursor
+ renames Base.Previous;
+
+ procedure Previous
+ (Position : in out Cursor)
+ renames Base.Previous;
+
+ function Follow
+ (Position : in Cursor;
+ Edge : in Edge_Type)
+ return Cursor
+ renames Base.Follow;
+
+ function Cursor_To
+ (Position : in Cursor;
+ Node : in Node_ID_Type)
+ return Cursor
+ renames Base.Cursor_To;
+
+
+
+
+private
+
+
+ type Parse_Graph is new Base.Graph with record
+ Root_Node : Extended_Node_ID_Type := No_Node;
+ end record;
+
+ Empty_Graph : constant Parse_Graph :=
+ (Base.Empty_Graph with Root_Node => No_Node);
+
+
+
+
+ package Node_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Node_ID_Type);
+
+ package Cursor_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Cursor);
+
+ package Finish_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Finish_Type);
+
+ package Finsort is new Finish_Vectors.Generic_Sorting;
+
+
+
+
+ generic
+ type Base_Type is private;
+ type Array_Type is array (Positive range <>) of Base_Type;
+ with package Type_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Base_Type);
+ function Vector_To_Array
+ (Input : in Type_Vectors.Vector)
+ return Array_Type;
+
+
+end Packrat.Parse_Graphs;
+
+