From 853a5a484f3e556a526473f23a60e3394b133abe Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 22 May 2020 22:23:22 +1000 Subject: Parse_Graphs complete but untested --- src/packrat-parse_graphs.ads | 556 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 556 insertions(+) create mode 100644 src/packrat-parse_graphs.ads (limited to 'src/packrat-parse_graphs.ads') 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; + + -- cgit