diff options
| -rw-r--r-- | src/packrat-graphs.adb | 1128 | ||||
| -rw-r--r-- | src/packrat-graphs.ads | 657 | ||||
| -rw-r--r-- | src/packrat-parse_graphs.ads | 9 |
3 files changed, 9 insertions, 1785 deletions
diff --git a/src/packrat-graphs.adb b/src/packrat-graphs.adb deleted file mode 100644 index 10e130f..0000000 --- a/src/packrat-graphs.adb +++ /dev/null @@ -1,1128 +0,0 @@ - - -with - - Ada.Unchecked_Deallocation; - - -package body Packrat.Graphs is - - - procedure Free_Element_Array is new Ada.Unchecked_Deallocation - (Element_Array, Element_Array_Access); - - - - - - function "<" - (Left, Right : in Choice_Down) - return Boolean is - begin - return Left.From < Right.From or else - (Left.From = Right.From and Left.Choice < Right.Choice); - end "<"; - - - - - - procedure Adjust - (This : in out Elem_Wrapper) - is - New_Array : Element_Array_Access; - begin - if This.Data /= null then - New_Array := new Element_Array (This.Data'First .. This.Data'Last); - New_Array.all := This.Data.all; - This.Data := New_Array; - end if; - end Adjust; - - - procedure Finalize - (This : in out Elem_Wrapper) is - begin - if This.Data /= null then - Free_Element_Array (This.Data); - end if; - end Finalize; - - - function Wrap - (Data : in Element_Array) - return Elem_Wrapper - is - New_Array : Element_Array_Access := - new Element_Array (Data'First .. Data'Last); - begin - New_Array.all := Data; - return (Ada.Finalization.Controlled with Data => New_Array); - end Wrap; - - - - - - function Leaf - (New_Item : in Element_Array; - Start : in Positive; - Finish : in Natural) - return Node is - begin - return This : Node do - This.Kind := Leaf_Node; - This.Content := Wrap (New_Item); - This.Start := Start; - This.Finish := Finish; - end return; - end Leaf; - - - function Branch - (Label : in Label_Enum; - Start : in Positive; - Finish : in Natural) - return Node is - begin - return This : Node do - This.Kind := Branch_Node; - This.Ident := Label; - This.Start := Start; - This.Finish := Finish; - end return; - end Branch; - - - - - - function Is_Nothing - (This : in Node) - return Boolean is - begin - return This.Kind = Null_Node; - end Is_Nothing; - - - function Is_Leaf - (This : in Node) - return Boolean is - begin - return This.Kind = Leaf_Node; - end Is_Leaf; - - - function Is_Branch - (This : in Node) - return Boolean is - begin - return This.Kind = Branch_Node; - end Is_Branch; - - - - - - function Label - (This : in Node) - return Label_Enum is - begin - return This.Ident; - end Label; - - - function Elements - (This : in Node) - return Element_Array is - begin - return This.Content.Data.all; - end Elements; - - - function Start - (This : in Node) - return Positive is - begin - return This.Start; - end Start; - - - function Finish - (This : in Node) - return Natural is - begin - return This.Finish; - end Finish; - - - - - - function Is_Nothing - (Position : in Cursor) - return Boolean is - begin - return Position.My_Graph = null or else - Position.Index = 0 or else - Position.Index > Position.My_Graph.all.Node_List.Last_Index or else - Position.My_Graph.all.Node_List.Element (Position.Index).Kind = Null_Node; - end Is_Nothing; - - - - - - function Depth - (Position : in Cursor) - return Natural is - begin - return Natural (Position.Track.Length); - end Depth; - - - function Is_Node - (Position : in Cursor) - return Boolean is - begin - return not Is_Nothing (Position); - end Is_Node; - - - function Is_Root - (Position : in Cursor) - return Boolean is - begin - return Position.My_Graph /= null and then - Position.My_Graph.all.Root_List.Contains (Position.Index) and then - Depth (Position) = 0; - end Is_Root; - - - function Is_Branch - (Position : in Cursor) - return Boolean is - begin - return Position.My_Graph /= null and then - Position.Index /= 0 and then - Position.Index <= Position.My_Graph.all.Node_List.Last_Index and then - Position.My_Graph.all.Node_List.Element (Position.Index).Kind = Branch_Node; - end Is_Branch; - - - function Is_Leaf - (Position : in Cursor) - return Boolean is - begin - return Position.My_Graph /= null and then - Position.Index /= 0 and then - Position.Index <= Position.My_Graph.all.Node_List.Last_Index and then - Position.My_Graph.all.Node_List.Element (Position.Index).Kind = Leaf_Node; - end Is_Leaf; - - - function Label - (Position : in Cursor) - return Label_Enum is - begin - return Position.My_Graph.all.Node_List.Element (Position.Index).Ident; - end Label; - - - function Elements - (Position : in Cursor) - return Element_Array is - begin - return Position.My_Graph.all.Node_List.Element (Position.Index).Content.Data.all; - end Elements; - - - - - - function Start - (Position : in Cursor) - return Positive is - begin - return Position.My_Graph.all.Node_List.Element (Position.Index).Start; - end Start; - - - function Finish - (Position : in Cursor) - return Natural is - begin - return Position.My_Graph.all.Node_List.Element (Position.Index).Finish; - end Finish; - - - function Choices - (My_Graph : in Graph; - My_Index : in Node_Index) - return Natural is - begin - if not My_Graph.Choices.Contains (My_Index) then - return 0; - else - return My_Graph.Choices.Element (My_Index); - end if; - end Choices; - - - function Choices - (Position : in Cursor) - return Natural is - begin - if not Is_Branch (Position) then - return 0; - else - return Choices (Position.My_Graph.all, Position.Index); - end if; - end Choices; - - - - - - function Parent - (Position : in Cursor) - return Cursor is - begin - return Result : Cursor do - Result.My_Graph := Position.My_Graph; - Result.Track := Position.Track; - if Natural (Position.Track.Length) = 0 then - Result.Index := 0; - else - Result.Index := Position.Track.Last_Element.From; - Result.Track.Delete_Last; - end if; - end return; - end Parent; - - - function Child_Count - (Position : in Cursor; - Choice : in Positive) - return Natural is - begin - return Natural (Position.My_Graph.all.Down_Edges.Element ((Position.Index, Choice)).Length); - end Child_Count; - - - function Child_Count - (Position : in Cursor) - return Natural - is - Choice_Count : Natural := Choices (Position); - begin - if Choice_Count = 0 then - return 0; - else - return Natural (Position.My_Graph.all.Down_Edges.Element - ((Position.Index, Choice_Count)).Length); - end if; - end Child_Count; - - - function All_Child_Count - (Position : in Cursor) - return Natural - is - Result : Natural := 0; - begin - for C in Integer range 1 .. Choices (Position) loop - Result := Result + Child_Count (Position, C); - end loop; - return Result; - end All_Child_Count; - - - function First_Child - (Position : in Cursor; - Choice : in Positive) - return Cursor is - begin - return Result : Cursor do - Result.My_Graph := Position.My_Graph; - Result.Index := Position.My_Graph.all.Down_Edges.Element - ((Position.Index, Choice)).First_Element; - Result.Track := Position.Track; - Result.Track.Append ((Position.Index, Choice)); - end return; - end First_Child; - - - function Last_Child - (Position : in Cursor; - Choice : in Positive) - return Cursor is - begin - return Result : Cursor do - Result.My_Graph := Position.My_Graph; - Result.Index := Position.My_Graph.all.Down_Edges.Element - ((Position.Index, Choice)).Last_Element; - Result.Track := Position.Track; - Result.Track.Append ((Position.Index, Choice)); - end return; - end Last_Child; - - - function First_Child - (Position : in Cursor) - return Cursor - is - Choice : Natural := Choices (Position); - begin - return Result : Cursor do - Result.My_Graph := Position.My_Graph; - if Choice = 0 or Result.My_Graph = null then - Result.Index := 0; - else - Result.Index := Position.My_Graph.all.Down_Edges.Element - ((Position.Index, Choice)).First_Element; - end if; - Result.Track := Position.Track; - Result.Track.Append ((Position.Index, Choice)); - end return; - end First_Child; - - - function Last_Child - (Position : in Cursor) - return Cursor - is - Choice : Natural := Choices (Position); - begin - return Result : Cursor do - Result.My_Graph := Position.My_Graph; - if Choice = 0 or Result.My_Graph = null then - Result.Index := 0; - else - Result.Index := Position.My_Graph.all.Down_Edges.Element - ((Position.Index, Choice)).Last_Element; - end if; - Result.Track := Position.Track; - Result.Track.Append ((Position.Index, Choice)); - end return; - end Last_Child; - - - function Next_Sibling - (Position : in Cursor) - return Cursor - is - Parent_Index : Extended_Node_Index; - Choice : Natural; - Sibling : Index_Vectors.Cursor; - begin - if Depth (Position) = 0 then - Parent_Index := 0; - Choice := 0; - else - Parent_Index := Position.Track.Last_Element.From; - Choice := Position.Track.Last_Element.Choice; - end if; - return Result : Cursor do - Result.My_Graph := Position.My_Graph; - if Choice = 0 or Parent_Index = 0 or Result.My_Graph = null or Position.Index = 0 then - Result.Index := 0; - else - Sibling := Result.My_Graph.all.Down_Edges.Element - ((Parent_Index, Choice)).Find (Position.Index); - Index_Vectors.Next (Sibling); - if Index_Vectors.Has_Element (Sibling) then - Result.Index := Index_Vectors.Element (Sibling); - else - Result.Index := 0; - end if; - end if; - Result.Track := Position.Track; - end return; - end Next_Sibling; - - - function Prev_Sibling - (Position : in Cursor) - return Cursor - is - Parent_Index : Extended_Node_Index; - Choice : Natural; - Sibling : Index_Vectors.Cursor; - begin - if Depth (Position) = 0 then - Parent_Index := 0; - Choice := 0; - else - Parent_Index := Position.Track.Last_Element.From; - Choice := Position.Track.Last_Element.Choice; - end if; - return Result : Cursor do - Result.My_Graph := Position.My_Graph; - if Choice = 0 or Parent_Index = 0 or Result.My_Graph = null or Position.Index = 0 then - Result.Index := 0; - else - Sibling := Result.My_Graph.all.Down_Edges.Element - ((Parent_Index, Choice)).Find (Position.Index); - Index_Vectors.Previous (Sibling); - if Index_Vectors.Has_Element (Sibling) then - Result.Index := Index_Vectors.Element (Sibling); - else - Result.Index := 0; - end if; - end if; - Result.Track := Position.Track; - end return; - end Prev_Sibling; - - - - - - procedure Delete_Loose_Subgraph - (Container : in out Graph; - Index : in Node_Index) - is - use type Ada.Containers.Count_Type; - Number_Choices : Natural; - begin - if Container.Up_Edges.Contains (Index) and then - Container.Up_Edges.Reference (Index).Length > 0 - then - -- If this subgraph is still connected to the rest of the graph, - -- then we do nothing. - return; - end if; - - if Container.Choices.Contains (Index) then - Number_Choices := Container.Choices.Element (Index); - else - Number_Choices := 0; - end if; - - for C in reverse Integer range 1 .. Number_Choices loop - declare - Edges : Edge_Down_Maps.Reference_Type := - Container.Down_Edges.Reference ((Index, C)); - begin - for I in reverse Integer range 1 .. Edges.Last_Index loop - declare - Elem : Node_Index := Edges.Element.Element (I); - begin - Container.Delete_Up_Edge (Elem, Index); - Container.Delete_Loose_Subgraph (Elem); - end; - end loop; - end; - Container.Delete_Down_Edges (Index, C); - end loop; - - Container.Node_List.Reference (Index).Kind := Null_Node; - if Index < Container.Add_Place then - Container.Add_Place := Index; - end if; - while Container.Node_List.Length > 0 and then - Container.Node_List.Last_Element.Kind = Null_Node - loop - Container.Node_List.Delete_Last; - end loop; - - if Container.Root_List.Contains (Index) then - Container.Root_List.Delete (Container.Root_List.Reverse_Find_Index (Index)); - end if; - end Delete_Loose_Subgraph; - - - procedure Delete_Up_Edge - (Container : in out Graph; - Current, Parent : in Node_Index) - is - Index_List : Edge_Up_Maps.Reference_Type := - Container.Up_Edges.Reference (Current); - Place : Natural := Index_List.Reverse_Find_Index (Parent); - begin - Index_List.Delete (Place); - if Index_List.Is_Empty then - Container.Up_Edges.Delete (Current); - end if; - end Delete_Up_Edge; - - - procedure Delete_Down_Edges - (Container : in out Graph; - From : in Node_Index; - Choice : in Positive) - is - Number_Choices : Choice_Maps.Reference_Type := Container.Choices.Reference (From); - begin - for C in Integer range Choice + 1 .. Number_Choices loop - Container.Down_Edges.Replace - ((From, C - 1), - Container.Down_Edges.Element ((From, C))); - end loop; - Container.Down_Edges.Delete ((From, Number_Choices)); - Number_Choices := Number_Choices - 1; - if Number_Choices < 1 then - Container.Choices.Delete (From); - end if; - end Delete_Down_Edges; - - - procedure Delete_Children - (Position : in out Cursor; - Choice : in Positive) - is - use type Ada.Containers.Count_Type; - Index_List : Edge_Down_Maps.Reference_Type := - Position.My_Graph.all.Down_Edges.Reference ((Position.Index, Choice)); - begin - for I in reverse Integer range Index_List.First_Index .. Index_List.Last_Index loop - declare - Elem : Node_Index := Index_List.Element.Element (I); - begin - Position.My_Graph.all.Delete_Up_Edge (Elem, Position.Index); - Position.My_Graph.all.Delete_Loose_Subgraph (Elem); - end; - end loop; - Position.My_Graph.all.Delete_Down_Edges (Position.Index, Choice); - while Position.My_Graph.all.Node_List.Length > 0 and then - Position.My_Graph.all.Node_List.Last_Element.Kind = Null_Node - loop - Position.My_Graph.all.Node_List.Delete_Last; - end loop; - end Delete_Children; - - - procedure Delete_Children - (Position : in out Cursor) - is - Choice : Natural := Choices (Position); - begin - if Choice > 0 then - Delete_Children (Position, Choice); - end if; - end Delete_Children; - - - procedure Delete_All_Children - (Position : in out Cursor) is - begin - for I in reverse Integer range 1 .. Choices (Position) loop - Delete_Children (Position, I); - end loop; - end Delete_All_Children; - - - - - - function Equal_Subgraph - (Left_Graph, Right_Graph : in Graph; - Left_Index, Right_Index : in Node_Index) - return Boolean - is - use type Ada.Containers.Count_Type; - begin - if Left_Graph.Node_List.Element (Left_Index) /= - Right_Graph.Node_List.Element (Right_Index) - then - return False; - end if; - - if Choices (Left_Graph, Left_Index) /= - Choices (Right_Graph, Right_Index) - then - return False; - end if; - - for C in Integer range 1 .. Choices (Left_Graph, Left_Index) loop - declare - Left_List : Edge_Down_Maps.Constant_Reference_Type := - Left_Graph.Down_Edges.Constant_Reference ((Left_Index, C)); - Right_List : Edge_Down_Maps.Constant_Reference_Type := - Right_Graph.Down_Edges.Constant_Reference ((Right_Index, C)); - begin - if Left_List.Length /= Right_List.Length then - return False; - end if; - for I in Integer range 1 .. Left_List.Last_Index loop - if not Equal_Subgraph - (Left_Graph, - Right_Graph, - Left_List.Element.Element (I), - Right_List.Element.Element (I)) - then - return False; - end if; - end loop; - end; - end loop; - - return True; - end Equal_Subgraph; - - - function Equal_Subgraph - (Left, Right : in Cursor) - return Boolean is - begin - return Equal_Subgraph - (Left.My_Graph.all, - Right.My_Graph.all, - Left.Index, - Right.Index); - end Equal_Subgraph; - - - - - - function Node_Count - (Container : in Graph; - Root_List : in Index_Vectors.Vector) - return Natural - is - Result : Natural := 0; - Current_Vector : Index_Vectors.Vector := Root_List; - New_Vector : Index_Vectors.Vector := Index_Vectors.Empty_Vector; - begin - while Natural (Current_Vector.Length) > 0 loop - Result := Result + Natural (Current_Vector.Length); - for N of Current_Vector loop - if Is_Branch (Container.Node_List.Element (N)) and - Container.Choices.Contains (N) - then - for C in Integer range 1 .. Container.Choices.Element (N) loop - New_Vector.Append (Container.Down_Edges.Element ((N, C))); - end loop; - end if; - end loop; - Current_Vector := New_Vector; - New_Vector.Clear; - end loop; - return Result; - end Node_Count; - - - function Subgraph_Node_Count - (Position : in Cursor) - return Natural - is - use type Index_Vectors.Vector; - begin - return Node_Count - (Position.My_Graph.all, - Index_Vectors.Empty_Vector & Position.Index); - end Subgraph_Node_Count; - - - function Find_In_Subgraph - (Position : in Cursor; - Item : in Element_Array) - return Cursor is - begin - return This : Cursor; - end Find_In_Subgraph; - - - - - - function Contains - (Container : in Graph; - Position : in Cursor) - return Boolean is - begin - return Position.My_Graph = Container'Unrestricted_Access and then - Position.Index < Container.Node_List.Last_Index and then - Position.Index > 0 and then - Container.Node_List.Element (Position.Index).Kind /= Null_Node; - end Contains; - - - - - function Singleton - (Input : in Node) - return Graph is - begin - return Result : Graph do - Result.Root_List := Index_Vectors.Empty_Vector; - Result.Root_List.Append (1); - Result.Node_List := Node_Vectors.Empty_Vector; - Result.Node_List.Append (Input); - Result.Add_Place := 2; - Result.Choices := Choice_Maps.Empty_Map; - Result.Down_Edges := Edge_Down_Maps.Empty_Map; - Result.Up_Edges := Edge_Up_Maps.Empty_Map; - end return; - end Singleton; - - - function Node_At - (Container : in Graph; - Position : in Cursor) - return Node_Reference is - begin - return (Data => No_Node'Unrestricted_Access); - end Node_At; - - - - - - function Is_Empty - (Container : in Graph) - return Boolean is - begin - return Container.Root_List.Is_Empty; - end Is_Empty; - - - function Is_Ambiguous - (Container : in Graph) - return Boolean is - begin - if Natural (Container.Root_List.Length) > 1 then - return True; - end if; - for N in Node_Index range 1 .. Container.Node_List.Last_Index loop - if Container.Node_List.Element (N).Kind = Branch_Node and then - Container.Choices.Contains (N) and then - Container.Choices.Element (N) > 1 - then - return True; - end if; - end loop; - return False; - end Is_Ambiguous; - - - function Node_Count - (Container : in Graph) - return Natural is - begin - return Node_Count (Container, Container.Root_List); - end Node_Count; - - - - - - function Root_Count - (Container : in Graph) - return Natural is - begin - return Natural (Container.Root_List.Length); - end Root_Count; - - - function Root - (Container : in Graph; - Index : in Positive) - return Cursor is - begin - return Result : Cursor do - Result.My_Graph := Container'Unrestricted_Access; - Result.Index := Container.Root_List.Element (Index); - Result.Track := Choice_Down_Vectors.Empty_Vector; - end return; - end Root; - - - - - - procedure Add_Nodes - (Container : in out Graph; - Addition : in Node_Vectors.Vector; - Mapping : out Index_Maps.Map) is - begin - Mapping := Index_Maps.Empty_Map; - for C in Addition.Iterate loop - Mapping.Insert (Node_Vectors.To_Index (C), Container.Add_Place); - if Container.Add_Place > Container.Node_List.Last_Index then - Container.Node_List.Append (Node_Vectors.Element (C)); - else - Container.Node_List.Replace_Element (Container.Add_Place, Node_Vectors.Element (C)); - end if; - while Container.Add_Place <= Container.Node_List.Last_Index and then - not Is_Nothing (Container.Node_List.Element (Container.Add_Place)) - loop - Container.Add_Place := Container.Add_Place + 1; - end loop; - end loop; - end Add_Nodes; - - - procedure Add_Edges - (Container : in out Graph; - Addition : in Graph; - Mapping : in Index_Maps.Map) - is - Targets : Index_Vectors.Vector := Index_Vectors.Empty_Vector; - begin - -- Up edges - for E in Addition.Up_Edges.Iterate loop - Targets.Clear; - for T of Edge_Up_Maps.Element (E) loop - Targets.Append (Mapping.Element (T)); - end loop; - Container.Up_Edges.Insert - (Mapping.Element (Edge_Up_Maps.Key (E)), Targets); - end loop; - - -- Down edges - for E in Addition.Down_Edges.Iterate loop - Targets.Clear; - for T of Edge_Down_Maps.Element (E) loop - Targets.Append (Mapping.Element (T)); - end loop; - Container.Down_Edges.Insert - ((Mapping.Element (Edge_Down_Maps.Key (E).From), Edge_Down_Maps.Key (E).Choice), - Targets); - end loop; - - -- Choices - for C in Addition.Choices.Iterate loop - Container.Choices.Insert - (Mapping.Element (Choice_Maps.Key (C)), Choice_Maps.Element (C)); - end loop; - end Add_Edges; - - - procedure Append - (Container : in out Graph; - Addition : in Graph) - is - Mapping : Index_Maps.Map; - begin - -- Add the nodes and edges from the addition to the graph, - -- making sure to handle the conversion of the index each node - -- is stored at. If index conversion wasn't required this bit would - -- be much simpler. - Add_Nodes (Container, Addition.Node_List, Mapping); - Add_Edges (Container, Addition, Mapping); - - -- Append the root list of the addition to the graph - for R of Addition.Root_List loop - Container.Root_List.Append (Mapping.Element (R)); - end loop; - end Append; - - - procedure Prepend - (Container : in out Graph; - Addition : in Graph) - is - Mapping : Index_Maps.Map; - Converted_Roots : Index_Vectors.Vector := Index_Vectors.Empty_Vector; - begin - -- Add the nodes and edges from the addition to the graph, - -- making sure to handle the conversion of the index each node - -- is stored at. If index conversion wasn't required this bit would - -- be much simpler. - Add_Nodes (Container, Addition.Node_List, Mapping); - Add_Edges (Container, Addition, Mapping); - - -- Prepend the root list of the addition to the graph - for R of Addition.Root_List loop - Converted_Roots.Append (Mapping.Element (R)); - end loop; - Container.Root_List.Prepend (Converted_Roots); - end Prepend; - - - procedure Attach_Choice - (Container : in out Graph; - Position : in Cursor; - Addition : in Graph) is - begin - null; - end Attach_Choice; - - - - - - procedure Clear - (Container : in out Graph) is - begin - Container.Root_List.Clear; - Container.Node_List.Clear; - Container.Add_Place := 1; - Container.Choices.Clear; - Container.Down_Edges.Clear; - Container.Up_Edges.Clear; - end Clear; - - - procedure Delete_Position - (Container : in out Graph; - Position : in out Cursor) - is - use type Ada.Containers.Count_Type; - begin - if Position.Track.Length > 0 then - Delete_Up_Edge (Container, Position.Index, Position.Track.Last_Element.From); - declare - Last : Choice_Down := - Position.Track.Last_Element; - Ref : Edge_Down_Maps.Reference_Type := - Container.Down_Edges.Reference (Last); - Number_Choices : Choice_Maps.Reference_Type := - Container.Choices.Reference (Last.From); - begin - Ref.Delete (Ref.Find_Index (Position.Index)); - if Ref.Length = 0 then - for C in Integer range Last.Choice + 1 .. Number_Choices loop - Container.Down_Edges.Replace - ((Last.From, C - 1), - Container.Down_Edges.Element ((Last.From, C))); - end loop; - Container.Down_Edges.Delete ((Last.From, Number_Choices)); - Number_Choices := Number_Choices - 1; - if Number_Choices < 1 then - Container.Choices.Delete (Last.From); - end if; - end if; - end; - end if; - Delete_Loose_Subgraph (Container, Position.Index); - while Position.My_Graph.all.Node_List.Length > 0 and then - Position.My_Graph.all.Node_List.Last_Element.Kind = Null_Node - loop - Position.My_Graph.all.Node_List.Delete_Last; - end loop; - end Delete_Position; - - - - - - function Find - (Container : in Graph; - Item : in Element_Array) - return Cursor is - begin - return This : Cursor; - end Find; - - - - - - function Default_Choices - (Container : in Graph; - Position : in Cursor) - return Natural is - begin - if Is_Nothing (Position) then - return Container.Root_Count; - else - return Choices (Position); - end if; - end Default_Choices; - - - function Accept_All - (Position : in Cursor) - return Boolean is - begin - return not Is_Nothing (Position); - end Accept_All; - - - - - - function Iterate - (Container : in Graph; - Start_At : in Cursor := No_Position; - Choose : in Choosing_Function := Default_Choices'Access; - Filter : in Filter_Function := Accept_All'Access) - return Graph_Iterators.Reversible_Iterator'Class is - begin - return This : Reversible_Iterator do - This.My_Graph := Container'Unrestricted_Access; - This.Start_Pos := Start_At; - This.Rule := Specific_Branch; - This.Choose_Func := Choose; - This.Filter_Func := Filter; - end return; - end Iterate; - - - function Iterate_All - (Container : in Graph; - Start_At : in Cursor := No_Position; - Filter : in Filter_Function := Accept_All'Access) - return Graph_Iterators.Reversible_Iterator'Class is - begin - return This : Reversible_Iterator do - This.My_Graph := Container'Unrestricted_Access; - This.Start_Pos := Start_At; - This.Rule := All_Nodes; - This.Choose_Func := null; - This.Filter_Func := Filter; - end return; - end Iterate_All; - - - - - - function First - (Object : in Reversible_Iterator) - return Cursor is - begin - if Object.My_Graph = null or else Object.My_Graph.all.Is_Empty then - return No_Position; - elsif Is_Nothing (Object.Start_Pos) then - if Object.Rule = All_Nodes then - return Object.My_Graph.all.Root (1); - else - return Object.My_Graph.all.Root - (Object.Choose_Func (Object.My_Graph.all, No_Position)); - end if; - else - return Object.Start_Pos; - end if; - end First; - - - function Next - (Object : in Reversible_Iterator; - Place : in Cursor) - return Cursor is - begin - if Object.My_Graph = null or else - Object.My_Graph.all.Is_Empty or else - Is_Nothing (Place) - then - return No_Position; - end if; -- elsif - return No_Position; - end Next; - - - function Last - (Object : in Reversible_Iterator) - return Cursor is - begin - return No_Position; - end Last; - - - function Previous - (Object : in Reversible_Iterator; - Place : in Cursor) - return Cursor is - begin - return No_Position; - end Previous; - - -end Packrat.Graphs; - - diff --git a/src/packrat-graphs.ads b/src/packrat-graphs.ads deleted file mode 100644 index 6bceaaf..0000000 --- a/src/packrat-graphs.ads +++ /dev/null @@ -1,657 +0,0 @@ - - -with - - Ada.Iterator_Interfaces; - -private with - - Ada.Containers.Ordered_Maps, - Ada.Containers.Vectors; - - -generic - type Label_Enum is (<>); - type Element is private; - type Element_Array is array (Positive range <>) of Element; -package Packrat.Graphs is - - - type Node is private; - - type Node_Reference (Data : not null access Node) is limited null record - with Implicit_Dereference => Data; - - type Cursor is private; - - type Graph is tagged private - with Default_Iterator => Iterate, - Iterator_Element => Node_Reference, - Variable_Indexing => Node_At; - - - - - No_Position : constant Cursor; - - Empty_Graph : constant Graph; - - - - - function Leaf - (New_Item : in Element_Array; - Start : in Positive; - Finish : in Natural) - return Node - with Pre => - Finish + 1 >= Start, - Post => - Is_Leaf (Leaf'Result); - - function Branch - (Label : in Label_Enum; - Start : in Positive; - Finish : in Natural) - return Node - with Pre => - Finish + 1 >= Start, - Post => - Is_Branch (Branch'Result); - - - - - function Is_Leaf - (This : in Node) - return Boolean; - - function Is_Branch - (This : in Node) - return Boolean; - - - - - function Label - (This : in Node) - return Label_Enum - with Pre => - Is_Branch (This); - - function Elements - (This : in Node) - return Element_Array - with Pre => - Is_Leaf (This); - - function Start - (This : in Node) - return Positive; - - function Finish - (This : in Node) - return Natural; - - - - - function Is_Nothing - (Position : in Cursor) - return Boolean; - - - - - function Depth - (Position : in Cursor) - return Natural; - - function Is_Node - (Position : in Cursor) - return Boolean - with Post => - (if Is_Node'Result then not Is_Nothing (Position)); - - function Is_Root - (Position : in Cursor) - return Boolean - with Post => - (if Is_Root'Result then - not Is_Nothing (Position) and - Is_Nothing (Parent (Position)) and - Depth (Position) = 0); - - function Is_Branch - (Position : in Cursor) - return Boolean - with Post => - (if Is_Branch'Result then not Is_Nothing (Position)); - - function Is_Leaf - (Position : in Cursor) - return Boolean - with Post => - (if Is_Leaf'Result then not Is_Nothing (Position)); - - - - - function Label - (Position : in Cursor) - return Label_Enum - with Pre => - Is_Branch (Position); - - function Elements - (Position : in Cursor) - return Element_Array - with Pre => - Is_Leaf (Position); - - function Start - (Position : in Cursor) - return Positive - with Pre => - not Is_Nothing (Position); - - function Finish - (Position : in Cursor) - return Natural - with Pre => - not Is_Nothing (Position); - - function Choices - (Position : in Cursor) - return Natural; - - - - - function Parent - (Position : in Cursor) - return Cursor; - - function Child_Count - (Position : in Cursor; - Choice : in Positive) - return Natural - with Pre => - Choice <= Choices (Position); - - function Child_Count - (Position : in Cursor) - return Natural; - - function All_Child_Count - (Position : in Cursor) - return Natural; - - function First_Child - (Position : in Cursor; - Choice : in Positive) - return Cursor - with Pre => - Choice <= Choices (Position), - Post => - Parent (First_Child'Result) = Position; - - function Last_Child - (Position : in Cursor; - Choice : in Positive) - return Cursor - with Pre => - Choice <= Choices (Position), - Post => - Parent (Last_Child'Result) = Position; - - function First_Child - (Position : in Cursor) - return Cursor - with Post => - Parent (First_Child'Result) = Position; - - function Last_Child - (Position : in Cursor) - return Cursor - with Post => - Parent (Last_Child'Result) = Position; - - function Next_Sibling - (Position : in Cursor) - return Cursor - with Post => - Parent (Next_Sibling'Result) = Parent (Position); - - function Prev_Sibling - (Position : in Cursor) - return Cursor - with Post => - Parent (Prev_Sibling'Result) = Parent (Position); - - procedure Delete_Children - (Position : in out Cursor; - Choice : in Positive) - with Pre => - Choice <= Choices (Position), - Post => - Child_Count (Position, Choice) = 0; - - procedure Delete_Children - (Position : in out Cursor) - with Post => - Child_Count (Position) = 0; - - procedure Delete_All_Children - (Position : in out Cursor) - with Post => - All_Child_Count (Position) = 0; - - - - - function Equal_Subgraph - (Left, Right : in Cursor) - return Boolean - with Pre => - Is_Node (Left) and Is_Node (Right); - - function Subgraph_Node_Count - (Position : in Cursor) - return Natural; - - function Find_In_Subgraph - (Position : in Cursor; - Item : in Element_Array) - return Cursor - with Post => - Is_Nothing (Find_In_Subgraph'Result) or - Is_Leaf (Find_In_Subgraph'Result); - - - - - function Contains - (Container : in Graph; - Position : in Cursor) - return Boolean - with Post => - (if Contains'Result then not Is_Nothing (Position)); - - - - - function Singleton - (Input : in Node) - return Graph - with Post => - Singleton'Result.Node_Count = 1; - - function Node_At - (Container : in Graph; - Position : in Cursor) - return Node_Reference - with Pre => - Contains (Container, Position); - - - - - function Is_Empty - (Container : in Graph) - return Boolean - with Post => - (if Is_Empty'Result then Container.Node_Count = 0 else Container.Node_Count /= 0); - - function Is_Ambiguous - (Container : in Graph) - return Boolean; - - function Node_Count - (Container : in Graph) - return Natural; - - - - - function Root_Count - (Container : in Graph) - return Natural - with Post => - (if Container.Is_Empty then Root_Count'Result = 0 else Root_Count'Result > 0); - - function Root - (Container : in Graph; - Index : in Positive) - return Cursor - with Pre => - Index <= Container.Root_Count; - - - - - procedure Append - (Container : in out Graph; - Addition : in Graph) - with Pre => - Container.Is_Empty or else Addition.Is_Empty or else - Finish (Container.Root (Container.Root_Count)) < Start (Addition.Root (1)); - - procedure Prepend - (Container : in out Graph; - Addition : in Graph) - with Pre => - Container.Is_Empty or else Addition.Is_Empty or else - Start (Container.Root (1)) > Finish (Addition.Root (Addition.Root_Count)); - - procedure Attach_Choice - (Container : in out Graph; - Position : in Cursor; - Addition : in Graph) - with Pre => - Container.Contains (Position) and Is_Branch (Position) and - (Addition.Is_Empty or else - (Start (Position) <= Start (Addition.Root (1)) and - Finish (Position) >= Finish (Addition.Root (Addition.Root_Count)))); - - - - - procedure Clear - (Container : in out Graph) - with Post => - Container.Is_Empty; - - procedure Delete_Position - (Container : in out Graph; - Position : in out Cursor) - with Pre'Class => - Container.Contains (Position), - Post'Class => - not Container.Contains (Position); - - - - - function Find - (Container : in Graph; - Item : in Element_Array) - return Cursor - with Post => - Is_Leaf (Find'Result) or - Is_Nothing (Find'Result); - - - - - package Graph_Iterators is - new Ada.Iterator_Interfaces (Cursor, Is_Node); - - -- Note that if the given Cursor doesn't point to any position, - -- then the function should assume that the choice is of what root to - -- select and return that value. - type Choosing_Function is access function - (Container : in Graph; - Position : in Cursor) - return Natural; - - -- This function returns True if a Node pointed to by a Cursor should - -- be returned, and False if it should be ignored. An example of a - -- filter that will probably see a decent amount of use would be Is_Leaf. - type Filter_Function is access function - (Position : in Cursor) - return Boolean; - - - - - function Default_Choices - (Container : in Graph; - Position : in Cursor) - return Natural; - - function Accept_All - (Position : in Cursor) - return Boolean; - - - - - function Iterate - (Container : in Graph; - Start_At : in Cursor := No_Position; - Choose : in Choosing_Function := Default_Choices'Access; - Filter : in Filter_Function := Accept_All'Access) - return Graph_Iterators.Reversible_Iterator'Class - with Pre => - Container.Contains (Start_At) or Is_Nothing (Start_At); - - function Iterate_All - (Container : in Graph; - Start_At : in Cursor := No_Position; - Filter : in Filter_Function := Accept_All'Access) - return Graph_Iterators.Reversible_Iterator'Class - with Pre => - Container.Contains (Start_At) or Is_Nothing (Start_At); - - - - -private - - - subtype Node_Index is Positive; - subtype Extended_Node_Index is Natural; - - - - - function Choices - (My_Graph : in Graph; - My_Index : in Node_Index) - return Natural - with Pre => - My_Index <= My_Graph.Node_List.Last_Index; - - - procedure Delete_Loose_Subgraph - (Container : in out Graph; - Index : in Node_Index) - with Pre => - Index <= Container.Node_List.Last_Index and then - Container.Node_List.Element (Index).Kind /= Null_Node; - - procedure Delete_Up_Edge - (Container : in out Graph; - Current, Parent : in Node_Index) - with Pre => - Container.Up_Edges.Contains (Current) and then - Container.Up_Edges.Reference (Current).Contains (Parent); - - procedure Delete_Down_Edges - (Container : in out Graph; - From : in Node_Index; - Choice : in Positive) - with Pre => - Container.Choices.Contains (From) and then - Container.Choices.Element (From) > 0 and then - Container.Down_Edges.Contains ((From, Choice)), - Post => - not Container.Down_Edges.Contains ((From, Choice)); - - - function Equal_Subgraph - (Left_Graph, Right_Graph : in Graph; - Left_Index, Right_Index : in Node_Index) - return Boolean - with Pre => - Left_Index <= Left_Graph.Node_List.Last_Index and - Right_Index <= Right_Graph.Node_List.Last_Index; - - - - - package Index_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Node_Index); - - package Index_Maps is new Ada.Containers.Ordered_Maps - (Key_Type => Node_Index, - Element_Type => Node_Index); - - - - - function Node_Count - (Container : in Graph; - Root_List : in Index_Vectors.Vector) - return Natural; - - - - - type Choice_Down is record - From : Extended_Node_Index; - Choice : Natural; - end record; - - function "<" - (Left, Right : in Choice_Down) - return Boolean; - - package Choice_Down_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Choice_Down); - - - - - package Choice_Maps is new Ada.Containers.Ordered_Maps - (Key_Type => Node_Index, - Element_Type => Natural); - - package Edge_Down_Maps is new Ada.Containers.Ordered_Maps - (Key_Type => Choice_Down, - Element_Type => Index_Vectors.Vector, - "=" => Index_Vectors."="); - - package Edge_Up_Maps is new Ada.Containers.Ordered_Maps - (Key_Type => Node_Index, - Element_Type => Index_Vectors.Vector, - "=" => Index_Vectors."="); - - - - - type Element_Array_Access is access Element_Array; - - type Elem_Wrapper is new Ada.Finalization.Controlled with record - Data : Element_Array_Access; - end record; - - overriding procedure Adjust - (This : in out Elem_Wrapper); - - overriding procedure Finalize - (This : in out Elem_Wrapper); - - function Wrap - (Data : in Element_Array) - return Elem_Wrapper; - - Empty_Wrapper : constant Elem_Wrapper := - (Ada.Finalization.Controlled with Data => null); - - type Node_Kind is (Null_Node, Branch_Node, Leaf_Node); - - type Node is record - Kind : Node_Kind; - Ident : Label_Enum; - Content : Elem_Wrapper; - Start : Positive; - Finish : Natural; - end record; - - package Node_Vectors is new Ada.Containers.Vectors - (Index_Type => Node_Index, - Element_Type => Node); - - - - - type Cursor is record - My_Graph : access Graph; - Index : Extended_Node_Index; - Track : Choice_Down_Vectors.Vector; - end record; - - - - - type Graph is tagged record - Root_List : Index_Vectors.Vector; - Node_List : Node_Vectors.Vector; - Add_Place : Node_Index; - Choices : Choice_Maps.Map; - Down_Edges : Edge_Down_Maps.Map; - Up_Edges : Edge_Up_Maps.Map; - end record; - - - - - No_Node : constant Node := - (Kind => Null_Node, - Ident => Label_Enum'First, - Content => Empty_Wrapper, - Start => 1, - Finish => 0); - - No_Position : constant Cursor := - (My_Graph => null, - Index => 0, - Track => Choice_Down_Vectors.Empty_Vector); - - Empty_Graph : constant Graph := - (Root_List => Index_Vectors.Empty_Vector, - Node_List => Node_Vectors.Empty_Vector, - Add_Place => 1, - Choices => Choice_Maps.Empty_Map, - Down_Edges => Edge_Down_Maps.Empty_Map, - Up_Edges => Edge_Up_Maps.Empty_Map); - - - - - type Iterate_Kind is (Specific_Branch, All_Nodes); - - type Reversible_Iterator is new Graph_Iterators.Reversible_Iterator with record - My_Graph : access Graph; - Start_Pos : Cursor; - Rule : Iterate_Kind; - Choose_Func : Choosing_Function; - Filter_Func : Filter_Function; - end record; - - overriding function First - (Object : in Reversible_Iterator) - return Cursor; - - overriding function Next - (Object : in Reversible_Iterator; - Place : in Cursor) - return Cursor; - - overriding function Last - (Object : in Reversible_Iterator) - return Cursor; - - overriding function Previous - (Object : in Reversible_Iterator; - Place : in Cursor) - return Cursor; - - -end Packrat.Graphs; - - diff --git a/src/packrat-parse_graphs.ads b/src/packrat-parse_graphs.ads index 0a3660e..d9cde0b 100644 --- a/src/packrat-parse_graphs.ads +++ b/src/packrat-parse_graphs.ads @@ -180,6 +180,15 @@ package Packrat.Parse_Graphs is + -- Other things needed here... + -- Equal_Subgraph? (in Directed_Graph lib) + -- Is_Ambiguous? + -- Iterate_Short, Iterate_Long, Iterate_By + -- Choosing and Filtering functions for Iterate_By + + + + -- 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 |