diff options
| -rw-r--r-- | src/packrat-graphs.adb | 303 | ||||
| -rw-r--r-- | src/packrat-graphs.ads | 60 |
2 files changed, 322 insertions, 41 deletions
diff --git a/src/packrat-graphs.adb b/src/packrat-graphs.adb index cc5a024..1cc21b3 100644 --- a/src/packrat-graphs.adb +++ b/src/packrat-graphs.adb @@ -249,15 +249,26 @@ package body Packrat.Graphs is 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; - elsif not Position.My_Graph.all.Choices.Contains (Position.Index) then - return 0; else - return Position.My_Graph.all.Choices.Element (Position.Index); + return Choices (Position.My_Graph.all, Position.Index); end if; end Choices; @@ -457,25 +468,140 @@ package body Packrat.Graphs is 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 - begin - null; + 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 + (Position : in out Cursor) + is + Choice : Natural := Choices (Position); begin - null; + if Choice > 0 then + Delete_Children (Position, Choice); + end if; end Delete_Children; procedure Delete_All_Children (Position : in out Cursor) is begin - null; + for I in reverse Integer range 1 .. Choices (Position) loop + Delete_Children (Position, I); + end loop; end Delete_All_Children; @@ -483,18 +609,102 @@ package body Packrat.Graphs is 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 False; + 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 + return Natural + is + use type Index_Vectors.Vector; begin - return 0; + return Node_Count + (Position.My_Graph.all, + Index_Vectors.Empty_Vector & Position.Index); end Subgraph_Node_Count; @@ -515,11 +725,10 @@ package body Packrat.Graphs is Position : in Cursor) return Boolean is begin - return False; - -- return Position.Graph.all = Container 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; + 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; @@ -583,27 +792,9 @@ package body Packrat.Graphs is function Node_Count (Container : in Graph) - return Natural - is - Result : Natural := 0; - Current_Vector : Index_Vectors.Vector := Container.Root_List; - New_Vector : Index_Vectors.Vector := Index_Vectors.Empty_Vector; + return Natural is 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; + return Node_Count (Container, Container.Root_List); end Node_Count; @@ -676,9 +867,41 @@ package body Packrat.Graphs is procedure Delete_Position (Container : in out Graph; - Position : in out Cursor) is - begin - null; + 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; diff --git a/src/packrat-graphs.ads b/src/packrat-graphs.ads index cd5c364..76be2e4 100644 --- a/src/packrat-graphs.ads +++ b/src/packrat-graphs.ads @@ -252,7 +252,9 @@ package Packrat.Graphs is function Equal_Subgraph (Left, Right : in Cursor) - return Boolean; + return Boolean + with Pre => + Is_Node (Left) and Is_Node (Right); function Subgraph_Node_Count (Position : in Cursor) @@ -415,6 +417,54 @@ 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); @@ -422,6 +472,14 @@ private + 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; |