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;