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_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 (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); 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_Children (Position : in out Cursor; Choice : in Positive) is begin null; end Delete_Children; procedure Delete_Children (Position : in out Cursor) is begin null; end Delete_Children; procedure Delete_All_Children (Position : in out Cursor) is begin null; end Delete_All_Children; function Equal_Subgraph (Left, Right : in Cursor) return Boolean is begin return False; end Equal_Subgraph; function Subgraph_Node_Count (Position : in Cursor) return Natural is begin return 0; 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 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; 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 Result : Natural := 0; Current_Vector : Index_Vectors.Vector := Container.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 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 Append (Container : in out Graph; Addition : in Graph) is begin null; end Append; procedure Prepend (Container : in out Graph; Addition : in Graph) is begin null; 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 begin null; end Delete_Position; function Find (Container : in Graph; Item : in Element_Array) return Cursor is begin return This : Cursor; end Find; function Iterate (This : in Graph) return Graph_Iterators.Reversible_Iterator'Class is begin return Result : Reversible_Iterator do Result.Position := No_Position; end return; end Iterate; function Iterate_Subtree (This : in Graph; Position : in Cursor) return Graph_Iterators.Reversible_Iterator'Class is begin return Result : Reversible_Iterator do Result.Position := No_Position; end return; end Iterate_Subtree; function Iterate_Choice (This : in Graph; Func : in Choosing_Function) return Graph_Iterators.Forward_Iterator'Class is begin return Result : Forward_Iterator do Result.Position := No_Position; end return; end Iterate_Choice; function First (Object : in Forward_Iterator) return Cursor is begin return No_Position; end First; function Next (Object : in Forward_Iterator; Place : in Cursor) return Cursor is begin return No_Position; end Next; function First (Object : in Reversible_Iterator) return Cursor is begin return No_Position; end First; function Next (Object : in Reversible_Iterator; Place : in Cursor) return Cursor is begin 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;