diff options
| -rw-r--r-- | src/packrat-graphs.adb | 461 | ||||
| -rw-r--r-- | src/packrat-graphs.ads | 381 | ||||
| -rw-r--r-- | src/packrat.ads | 341 | ||||
| -rw-r--r-- | test/ratnest-tests-graphs.adb | 82 |
4 files changed, 675 insertions, 590 deletions
diff --git a/src/packrat-graphs.adb b/src/packrat-graphs.adb index 1411259..cc5a024 100644 --- a/src/packrat-graphs.adb +++ b/src/packrat-graphs.adb @@ -1,8 +1,68 @@ +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; @@ -10,7 +70,12 @@ package body Packrat.Graphs is Finish : in Natural) return Node is begin - return This : Node; + return This : Node do + This.Kind := Leaf_Node; + This.Content := Wrap (New_Item); + This.Start := Start; + This.Finish := Finish; + end return; end Leaf; @@ -20,7 +85,12 @@ package body Packrat.Graphs is Finish : in Natural) return Node is begin - return This : Node; + return This : Node do + This.Kind := Branch_Node; + This.Ident := Label; + This.Start := Start; + This.Finish := Finish; + end return; end Branch; @@ -31,7 +101,7 @@ package body Packrat.Graphs is (This : in Node) return Boolean is begin - return False; + return This.Kind = Leaf_Node; end Is_Leaf; @@ -39,7 +109,7 @@ package body Packrat.Graphs is (This : in Node) return Boolean is begin - return False; + return This.Kind = Branch_Node; end Is_Branch; @@ -50,17 +120,15 @@ package body Packrat.Graphs is (This : in Node) return Label_Enum is begin - return Label_Enum'First; + return This.Ident; end Label; function Elements (This : in Node) - return Element_Array - is - Empty : Element_Array (1 .. 0); + return Element_Array is begin - return Empty; + return This.Content.Data.all; end Elements; @@ -68,7 +136,7 @@ package body Packrat.Graphs is (This : in Node) return Positive is begin - return 1; + return This.Start; end Start; @@ -76,7 +144,7 @@ package body Packrat.Graphs is (This : in Node) return Natural is begin - return 0; + return This.Finish; end Finish; @@ -87,7 +155,10 @@ package body Packrat.Graphs is (Position : in Cursor) return Boolean is begin - return True; + 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; @@ -98,7 +169,7 @@ package body Packrat.Graphs is (Position : in Cursor) return Natural is begin - return 0; + return Natural (Position.Track.Length); end Depth; @@ -106,7 +177,7 @@ package body Packrat.Graphs is (Position : in Cursor) return Boolean is begin - return False; + return not Is_Nothing (Position); end Is_Node; @@ -114,7 +185,9 @@ package body Packrat.Graphs is (Position : in Cursor) return Boolean is begin - return False; + return Position.My_Graph /= null and then + Position.My_Graph.all.Root_List.Contains (Position.Index) and then + Depth (Position) = 0; end Is_Root; @@ -122,7 +195,10 @@ package body Packrat.Graphs is (Position : in Cursor) return Boolean is begin - return False; + 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; @@ -130,7 +206,10 @@ package body Packrat.Graphs is (Position : in Cursor) return Boolean is begin - return False; + 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; @@ -138,17 +217,15 @@ package body Packrat.Graphs is (Position : in Cursor) return Label_Enum is begin - return Label_Enum'First; + return Position.My_Graph.all.Node_List.Element (Position.Index).Ident; end Label; function Elements (Position : in Cursor) - return Element_Array - is - Empty : Element_Array (1 .. 0); + return Element_Array is begin - return Empty; + return Position.My_Graph.all.Node_List.Element (Position.Index).Content.Data.all; end Elements; @@ -159,7 +236,7 @@ package body Packrat.Graphs is (Position : in Cursor) return Positive is begin - return 1; + return Position.My_Graph.all.Node_List.Element (Position.Index).Start; end Start; @@ -167,7 +244,7 @@ package body Packrat.Graphs is (Position : in Cursor) return Natural is begin - return 0; + return Position.My_Graph.all.Node_List.Element (Position.Index).Finish; end Finish; @@ -175,7 +252,13 @@ package body Packrat.Graphs is (Position : in Cursor) return Natural is begin - return 0; + 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; @@ -186,7 +269,16 @@ package body Packrat.Graphs is (Position : in Cursor) return Cursor is begin - return This : Cursor; + 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; @@ -195,23 +287,35 @@ package body Packrat.Graphs is Choice : in Positive) return Natural is begin - return 0; + 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 - begin - return 0; + 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 + return Natural + is + Result : Natural := 0; begin - return 0; + for C in Integer range 1 .. Choices (Position) loop + Result := Result + Child_Count (Position, C); + end loop; + return Result; end All_Child_Count; @@ -220,7 +324,13 @@ package body Packrat.Graphs is Choice : in Positive) return Cursor is begin - return This : Cursor; + 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; @@ -229,39 +339,121 @@ package body Packrat.Graphs is Choice : in Positive) return Cursor is begin - return This : Cursor; + 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 - begin - return This : 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 - begin - return This : 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 - begin - return This : 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 - begin - return This : 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; @@ -319,27 +511,40 @@ package body Packrat.Graphs is function Contains - (Container : in Parse_Graph; - Position : in My_Interfaces.Cursor'Class) + (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 My_Interfaces.Node'Class) - return Parse_Graph is - begin - return This : Parse_Graph; + (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 Parse_Graph; - Position : in My_Interfaces.Cursor'Class) + (Container : in Graph; + Position : in Cursor) return Node_Reference is begin return (Data => No_Node'Unrestricted_Access); @@ -350,26 +555,55 @@ package body Packrat.Graphs is function Is_Empty - (Container : in Parse_Graph) + (Container : in Graph) return Boolean is begin - return True; + return Container.Root_List.Is_Empty; end Is_Empty; function Is_Ambiguous - (Container : in Parse_Graph) + (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 Parse_Graph) - return Natural is - begin - return 0; + (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; @@ -377,19 +611,23 @@ package body Packrat.Graphs is function Root_Count - (Container : in Parse_Graph) + (Container : in Graph) return Natural is begin - return 0; + return Natural (Container.Root_List.Length); end Root_Count; function Root - (Container : in Parse_Graph; + (Container : in Graph; Index : in Positive) - return My_Interfaces.Cursor'Class is + return Cursor is begin - return This : Cursor; + 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; @@ -397,25 +635,25 @@ package body Packrat.Graphs is procedure Append - (Container : in out Parse_Graph; - Addition : in Parse_Graph) is + (Container : in out Graph; + Addition : in Graph) is begin null; end Append; procedure Prepend - (Container : in out Parse_Graph; - Addition : in Parse_Graph) is + (Container : in out Graph; + Addition : in Graph) is begin null; end Prepend; procedure Attach_Choice - (Container : in out Parse_Graph; - Position : in My_Interfaces.Cursor'Class; - Addition : in Parse_Graph) is + (Container : in out Graph; + Position : in Cursor; + Addition : in Graph) is begin null; end Attach_Choice; @@ -425,15 +663,20 @@ package body Packrat.Graphs is procedure Clear - (Container : in out Parse_Graph) is - begin - null; + (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 Parse_Graph; - Position : in out My_Interfaces.Cursor'Class) is + (Container : in out Graph; + Position : in out Cursor) is begin null; end Delete_Position; @@ -443,9 +686,9 @@ package body Packrat.Graphs is function Find - (Container : in Parse_Graph; + (Container : in Graph; Item : in Element_Array) - return My_Interfaces.Cursor'Class is + return Cursor is begin return This : Cursor; end Find; @@ -454,48 +697,34 @@ package body Packrat.Graphs is - function Is_Valid_Node - (Position : in Iter_Cursor) - return Boolean is - begin - return Position.Data.Is_Node; - end Is_Valid_Node; - - - - - function Iterate - (This : in Parse_Graph) + (This : in Graph) return Graph_Iterators.Reversible_Iterator'Class is begin return Result : Reversible_Iterator do - Result.My_Container := This'Unrestricted_Access; - Result.My_Position := Cursor (No_Position); + Result.Position := No_Position; end return; end Iterate; function Iterate_Subtree - (This : in Parse_Graph; - Position : in My_Interfaces.Cursor'Class) + (This : in Graph; + Position : in Cursor) return Graph_Iterators.Reversible_Iterator'Class is begin return Result : Reversible_Iterator do - Result.My_Container := This'Unrestricted_Access; - Result.My_Position := Cursor (No_Position); + Result.Position := No_Position; end return; end Iterate_Subtree; function Iterate_Choice - (This : in Parse_Graph; + (This : in Graph; Func : in Choosing_Function) return Graph_Iterators.Forward_Iterator'Class is begin return Result : Forward_Iterator do - Result.My_Container := This'Unrestricted_Access; - Result.My_Position := Cursor (No_Position); + Result.Position := No_Position; end return; end Iterate_Choice; @@ -505,17 +734,17 @@ package body Packrat.Graphs is function First (Object : in Forward_Iterator) - return Iter_Cursor is + return Cursor is begin - return (Data => Object.My_Position'Unrestricted_Access); + return No_Position; end First; function Next (Object : in Forward_Iterator; - Place : in Iter_Cursor) - return Iter_Cursor is + Place : in Cursor) + return Cursor is begin - return (Data => Object.My_Position'Unrestricted_Access); + return No_Position; end Next; @@ -524,35 +753,35 @@ package body Packrat.Graphs is function First (Object : in Reversible_Iterator) - return Iter_Cursor is + return Cursor is begin - return (Data => Object.My_Position'Unrestricted_Access); + return No_Position; end First; function Next (Object : in Reversible_Iterator; - Place : in Iter_Cursor) - return Iter_Cursor is + Place : in Cursor) + return Cursor is begin - return (Data => Object.My_Position'Unrestricted_Access); + return No_Position; end Next; function Last (Object : in Reversible_Iterator) - return Iter_Cursor is + return Cursor is begin - return (Data => Object.My_Position'Unrestricted_Access); + return No_Position; end Last; function Previous (Object : in Reversible_Iterator; - Place : in Iter_Cursor) - return Iter_Cursor is + Place : in Cursor) + return Cursor is begin - return (Data => Object.My_Position'Unrestricted_Access); + return No_Position; end Previous; diff --git a/src/packrat-graphs.ads b/src/packrat-graphs.ads index 0ef298e..cd5c364 100644 --- a/src/packrat-graphs.ads +++ b/src/packrat-graphs.ads @@ -4,28 +4,27 @@ 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; - with package My_Interfaces is new Interfaces (Label_Enum, Element, Element_Array); package Packrat.Graphs is - type Node is new My_Interfaces.Node with private; - - type Node_Reference (Data : not null access Node'Class) is limited null record - with Implicit_Dereference => Data; - - - type Cursor is new My_Interfaces.Cursor with private; + type Node is private; - type Iter_Cursor (Data : not null access Cursor) is private + type Node_Reference (Data : not null access Node) is limited null record with Implicit_Dereference => Data; + type Cursor is private; - type Parse_Graph is new My_Interfaces.Graph with private + type Graph is tagged private with Default_Iterator => Iterate, Iterator_Element => Node_Reference, Variable_Indexing => Node_At; @@ -33,9 +32,9 @@ package Packrat.Graphs is - No_Position : constant My_Interfaces.Cursor'Class; + No_Position : constant Cursor; - Empty_Graph : constant Parse_Graph; + Empty_Graph : constant Graph; @@ -44,13 +43,23 @@ package Packrat.Graphs is (New_Item : in Element_Array; Start : in Positive; Finish : in Natural) - return Node; + 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; + return Node + with Pre => + Finish + 1 >= Start, + Post => + Is_Branch (Branch'Result); + + function Is_Leaf @@ -62,13 +71,19 @@ package Packrat.Graphs is return Boolean; + + function Label (This : in Node) - return Label_Enum; + return Label_Enum + with Pre => + Is_Branch (This); function Elements (This : in Node) - return Element_Array; + return Element_Array + with Pre => + Is_Leaf (This); function Start (This : in Node) @@ -94,38 +109,57 @@ package Packrat.Graphs is function Is_Node (Position : in Cursor) - return Boolean; + return Boolean + with Post => + (if Is_Node'Result then not Is_Nothing (Position)); function Is_Root (Position : in Cursor) - return Boolean; + 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; + return Boolean + with Post => + (if Is_Branch'Result then not Is_Nothing (Position)); function Is_Leaf (Position : in Cursor) - return Boolean; + return Boolean + with Post => + (if Is_Leaf'Result then not Is_Nothing (Position)); function Label (Position : in Cursor) - return Label_Enum; + return Label_Enum + with Pre => + Is_Branch (Position); function Elements (Position : in Cursor) - return Element_Array; + return Element_Array + with Pre => + Is_Leaf (Position); function Start (Position : in Cursor) - return Positive; + return Positive + with Pre => + not Is_Nothing (Position); function Finish (Position : in Cursor) - return Natural; + return Natural + with Pre => + not Is_Nothing (Position); function Choices (Position : in Cursor) @@ -141,7 +175,9 @@ package Packrat.Graphs is function Child_Count (Position : in Cursor; Choice : in Positive) - return Natural; + return Natural + with Pre => + Choice <= Choices (Position); function Child_Count (Position : in Cursor) @@ -154,38 +190,62 @@ package Packrat.Graphs is function First_Child (Position : in Cursor; Choice : in Positive) - return Cursor; + return Cursor + with Pre => + Choice <= Choices (Position), + Post => + Parent (First_Child'Result) = Position; function Last_Child (Position : in Cursor; Choice : in Positive) - return Cursor; + return Cursor + with Pre => + Choice <= Choices (Position), + Post => + Parent (Last_Child'Result) = Position; function First_Child (Position : in Cursor) - return Cursor; + return Cursor + with Post => + Parent (First_Child'Result) = Position; function Last_Child (Position : in Cursor) - return Cursor; + return Cursor + with Post => + Parent (Last_Child'Result) = Position; function Next_Sibling (Position : in Cursor) - return Cursor; + return Cursor + with Post => + Parent (Next_Sibling'Result) = Parent (Position); function Prev_Sibling (Position : in Cursor) - return Cursor; + return Cursor + with Post => + Parent (Prev_Sibling'Result) = Parent (Position); procedure Delete_Children (Position : in out Cursor; - Choice : in Positive); + Choice : in Positive) + with Pre => + Choice <= Choices (Position), + Post => + Child_Count (Position, Choice) = 0; procedure Delete_Children - (Position : in out Cursor); + (Position : in out Cursor) + with Post => + Child_Count (Position) = 0; procedure Delete_All_Children - (Position : in out Cursor); + (Position : in out Cursor) + with Post => + All_Child_Count (Position) = 0; @@ -201,103 +261,129 @@ package Packrat.Graphs is function Find_In_Subgraph (Position : in Cursor; Item : in Element_Array) - return Cursor; + return Cursor + with Post => + Is_Nothing (Find_In_Subgraph'Result) or + Is_Leaf (Find_In_Subgraph'Result); function Contains - (Container : in Parse_Graph; - Position : in My_Interfaces.Cursor'Class) - return Boolean; + (Container : in Graph; + Position : in Cursor) + return Boolean + with Post => + (if Contains'Result then not Is_Nothing (Position)); function Singleton - (Input : in My_Interfaces.Node'Class) - return Parse_Graph; + (Input : in Node) + return Graph + with Post => + Singleton'Result.Node_Count = 1; function Node_At - (Container : in Parse_Graph; - Position : in My_Interfaces.Cursor'Class) + (Container : in Graph; + Position : in Cursor) return Node_Reference with Pre => - Position.Is_Node; + Contains (Container, Position); function Is_Empty - (Container : in Parse_Graph) - return Boolean; + (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 Parse_Graph) + (Container : in Graph) return Boolean; function Node_Count - (Container : in Parse_Graph) + (Container : in Graph) return Natural; function Root_Count - (Container : in Parse_Graph) - return Natural; + (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 Parse_Graph; + (Container : in Graph; Index : in Positive) - return My_Interfaces.Cursor'Class; + return Cursor + with Pre => + Index <= Container.Root_Count; procedure Append - (Container : in out Parse_Graph; - Addition : in Parse_Graph); + (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 Parse_Graph; - Addition : in Parse_Graph); + (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 Parse_Graph; - Position : in My_Interfaces.Cursor'Class; - Addition : in Parse_Graph); + (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 Parse_Graph); + (Container : in out Graph) + with Post => + Container.Is_Empty; procedure Delete_Position - (Container : in out Parse_Graph; - Position : in out My_Interfaces.Cursor'Class); + (Container : in out Graph; + Position : in out Cursor) + with Pre'Class => + Container.Contains (Position), + Post'Class => + not Container.Contains (Position); function Find - (Container : in Parse_Graph; + (Container : in Graph; Item : in Element_Array) - return My_Interfaces.Cursor'Class; - - - - - function Is_Valid_Node - (Position : in Iter_Cursor) - return Boolean; + return Cursor + with Post => + Is_Leaf (Find'Result) or + Is_Nothing (Find'Result); package Graph_Iterators is - new Ada.Iterator_Interfaces (Iter_Cursor, Is_Valid_Node); + new Ada.Iterator_Interfaces (Cursor, Is_Node); type Choosing_Function is access function (Position : in Cursor) @@ -307,16 +393,16 @@ package Packrat.Graphs is function Iterate - (This : in Parse_Graph) + (This : in Graph) return Graph_Iterators.Reversible_Iterator'Class; function Iterate_Subtree - (This : in Parse_Graph; - Position : in My_Interfaces.Cursor'Class) + (This : in Graph; + Position : in Cursor) return Graph_Iterators.Reversible_Iterator'Class; function Iterate_Choice - (This : in Parse_Graph; + (This : in Graph; Func : in Choosing_Function) return Graph_Iterators.Forward_Iterator'Class; @@ -326,63 +412,166 @@ package Packrat.Graphs is private - type Node is new My_Interfaces.Node with null record; + subtype Node_Index is Positive; + subtype Extended_Node_Index is Natural; + + package Index_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Node_Index); + + + + + 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 new My_Interfaces.Cursor with null record; - type Iter_Cursor (Data : not null access Cursor) is null record; + type Cursor is record + My_Graph : access Graph; + Index : Extended_Node_Index; + Track : Choice_Down_Vectors.Vector; + end record; + - type Parse_Graph is new My_Interfaces.Graph with null 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 := (My_Interfaces.Node with null record); - No_Position_Actual : constant Cursor := (My_Interfaces.Cursor with null record); - No_Position : constant My_Interfaces.Cursor'Class := No_Position_Actual; - Empty_Graph : constant Parse_Graph := (My_Interfaces.Graph with null 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 Forward_Iterator is new Graph_Iterators.Forward_Iterator with record - My_Container : access Parse_Graph; - My_Position : Cursor; + Position : Cursor; end record; overriding function First (Object : in Forward_Iterator) - return Iter_Cursor; + return Cursor; overriding function Next (Object : in Forward_Iterator; - Place : in Iter_Cursor) - return Iter_Cursor; + Place : in Cursor) + return Cursor; + + + type Reversible_Iterator is new Graph_Iterators.Reversible_Iterator with record - My_Container : access Parse_Graph; - My_Position : Cursor; + Position : Cursor; end record; overriding function First (Object : in Reversible_Iterator) - return Iter_Cursor; + return Cursor; overriding function Next (Object : in Reversible_Iterator; - Place : in Iter_Cursor) - return Iter_Cursor; + Place : in Cursor) + return Cursor; overriding function Last (Object : in Reversible_Iterator) - return Iter_Cursor; + return Cursor; overriding function Previous (Object : in Reversible_Iterator; - Place : in Iter_Cursor) - return Iter_Cursor; + Place : in Cursor) + return Cursor; end Packrat.Graphs; diff --git a/src/packrat.ads b/src/packrat.ads index d1fc9a0..4abdaec 100644 --- a/src/packrat.ads +++ b/src/packrat.ads @@ -184,347 +184,6 @@ package Packrat is - generic - type Label_Enum is (<>); - type Element is private; - type Element_Array is array (Positive range <>) of Element; - package Interfaces is - - - type Node is interface; - - - function Leaf - (New_Item : in Element_Array; - Start : in Positive; - Finish : in Natural) - return Node is abstract - with Pre'Class => - Finish + 1 >= Start, - Post'Class => - Is_Leaf (Leaf'Result); - - function Branch - (Label : in Label_Enum; - Start : in Positive; - Finish : in Natural) - return Node is abstract - with Pre'Class => - Finish + 1 >= Start, - Post'Class => - Is_Branch (Branch'Result); - - - function Is_Leaf - (This : in Node) - return Boolean is abstract; - - function Is_Branch - (This : in Node) - return Boolean is abstract; - - - function Label - (This : in Node) - return Label_Enum is abstract - with Pre'Class => - This.Is_Branch; - - function Elements - (This : in Node) - return Element_Array is abstract - with Pre'Class => - This.Is_Leaf; - - function Start - (This : in Node) - return Positive is abstract; - - function Finish - (This : in Node) - return Natural is abstract; - - - - - type Cursor is interface; - - - function Is_Nothing - (Position : in Cursor) - return Boolean is abstract; - - - function Depth - (Position : in Cursor) - return Natural is abstract - with Pre'Class => - not Position.Is_Nothing; - - function Is_Node - (Position : in Cursor) - return Boolean is abstract - with Post'Class => - (if Is_Node'Result then not Position.Is_Nothing); - - function Is_Root - (Position : in Cursor) - return Boolean is abstract - with Post'Class => - (if Is_Root'Result then - not Position.Is_Nothing and - Position.Parent.Is_Nothing and - Position.Depth = 0); - - function Is_Branch - (Position : in Cursor) - return Boolean is abstract - with Post'Class => - (if Is_Branch'Result then not Position.Is_Nothing); - - function Is_Leaf - (Position : in Cursor) - return Boolean is abstract - with Post'Class => - (if Is_Leaf'Result then not Position.Is_Nothing); - - - function Label - (Position : in Cursor) - return Label_Enum is abstract - with Pre'Class => - Position.Is_Branch; - - function Elements - (Position : in Cursor) - return Element_Array is abstract - with Pre'Class => - Position.Is_Leaf; - - function Start - (Position : in Cursor) - return Positive is abstract - with Pre'Class => - not Position.Is_Nothing; - - function Finish - (Position : in Cursor) - return Natural is abstract - with Pre'Class => - not Position.Is_Nothing; - - function Choices - (Position : in Cursor) - return Natural is abstract; - - - function Parent - (Position : in Cursor) - return Cursor is abstract; - - function Child_Count - (Position : in Cursor; - Choice : in Positive) - return Natural is abstract - with Pre'Class => - Choice <= Position.Choices; - - function Child_Count - (Position : in Cursor) - return Natural is abstract; - - function All_Child_Count - (Position : in Cursor) - return Natural is abstract; - - function First_Child - (Position : in Cursor; - Choice : in Positive) - return Cursor is abstract - with Pre'Class => - Choice <= Position.Choices, - Post'Class => - First_Child'Result.Is_Nothing or - First_Child'Result.Parent = Position; - - function Last_Child - (Position : in Cursor; - Choice : in Positive) - return Cursor is abstract - with Pre'Class => - Choice <= Position.Choices, - Post'Class => - Last_Child'Result.Is_Nothing or - Last_Child'Result.Parent = Position; - - function First_Child - (Position : in Cursor) - return Cursor is abstract - with Post'Class => - First_Child'Result.Is_Nothing or - First_Child'Result.Parent = Position; - - function Last_Child - (Position : in Cursor) - return Cursor is abstract - with Post'Class => - Last_Child'Result.Is_Nothing or - Last_Child'Result.Parent = Position; - - function Next_Sibling - (Position : in Cursor) - return Cursor is abstract - with Post'Class => - Next_Sibling'Result.Is_Nothing or - Next_Sibling'Result.Parent = Position.Parent; - - function Prev_Sibling - (Position : in Cursor) - return Cursor is abstract - with Post'Class => - Prev_Sibling'Result.Is_Nothing or - Prev_Sibling'Result.Parent = Position.Parent; - - procedure Delete_Children - (Position : in out Cursor; - Choice : in Positive) is abstract - with Pre'Class => - Choice <= Position.Choices, - Post'Class => - Position.Child_Count (Choice) = 0; - - procedure Delete_Children - (Position : in out Cursor) is abstract - with Post'Class => - Position.Child_Count = 0; - - procedure Delete_All_Children - (Position : in out Cursor) is abstract - with Post'Class => - Position.All_Child_Count = 0; - - - function Equal_Subgraph - (Left, Right : in Cursor) - return Boolean is abstract; - - function Subgraph_Node_Count - (Position : in Cursor) - return Natural is abstract; - - function Find_In_Subgraph - (Position : in Cursor; - Item : in Element_Array) - return Cursor is abstract - with Post'Class => - Find_In_Subgraph'Result.Is_Nothing or - Find_In_Subgraph'Result.Is_Leaf; - - - - - type Graph is interface; - - - function Contains - (Container : in Graph; - Position : in Cursor'Class) - return Boolean is abstract - with Post'Class => - (if Contains'Result then not Position.Is_Nothing); - - - function Singleton - (Input : in Node'Class) - return Graph is abstract - with Post'Class => - Singleton'Result.Node_Count = 1; - - - function Is_Empty - (Container : in Graph) - return Boolean is abstract - with Post'Class => - (if Is_Empty'Result then Container.Node_Count = 0 else Container.Node_Count /= 0); - - function Is_Ambiguous - (Container : in Graph) - return Boolean is abstract; - - function Node_Count - (Container : in Graph) - return Natural is abstract; - - - function Root_Count - (Container : in Graph) - return Natural is abstract - with Post'Class => - (if Container.Is_Empty then Root_Count'Result = 0 else Root_Count'Result > 0); - - function Root - (Container : in Graph; - Index : in Positive) - return Cursor'Class is abstract - with Pre'Class => - Index <= Container.Root_Count; - - - procedure Append - (Container : in out Graph; - Addition : in Graph) is abstract - with Pre'Class => - Container.Is_Empty or else Addition.Is_Empty or else - Container.Root (Container.Root_Count).Finish < - Addition.Root (1).Start; - - procedure Prepend - (Container : in out Graph; - Addition : in Graph) is abstract - with Pre'Class => - Container.Is_Empty or else Addition.Is_Empty or else - Container.Root (1).Start > - Addition.Root (Addition.Root_Count).Finish; - - procedure Attach_Choice - (Container : in out Graph; - Position : in Cursor'Class; - Addition : in Graph) is abstract - with Pre'Class => - Container.Contains (Position) and Position.Is_Branch and - (Addition.Is_Empty or else - (Position.Start <= Addition.Root (1).Start and - Position.Finish >= Addition.Root (Addition.Root_Count).Finish)); - - - procedure Clear - (Container : in out Graph) is abstract - with Post'Class => - Container.Is_Empty; - - procedure Delete_Position - (Container : in out Graph; - Position : in out Cursor'Class) is abstract - with Pre'Class => - Container.Contains (Position), - Post'Class => - not Container.Contains (Position); - - - function Find - (Container : in Graph; - Item : in Element_Array) - return Cursor'Class is abstract - with Post'Class => - Find'Result.Is_Leaf or - Find'Result.Is_Nothing; - - - end Interfaces; - - - - private diff --git a/test/ratnest-tests-graphs.adb b/test/ratnest-tests-graphs.adb index 8776336..24b03c9 100644 --- a/test/ratnest-tests-graphs.adb +++ b/test/ratnest-tests-graphs.adb @@ -6,12 +6,12 @@ package body Graphs is type My_Labels is (One, Two, Three, Four, Five, Six); - package My_Interfaces is new Packrat.Interfaces (My_Labels, Character, String); - package My_Graphs is new Packrat.Graphs (My_Labels, Character, String, My_Interfaces); + package My_Graphs is new Packrat.Graphs (My_Labels, Character, String); - use type My_Interfaces.Cursor; - use type My_Graphs.Parse_Graph; + use type My_Graphs.Node; + use type My_Graphs.Cursor; + use type My_Graphs.Graph; function Node_Check @@ -20,9 +20,9 @@ package body Graphs is Leafeon : My_Graphs.Node := My_Graphs.Leaf ("abc", 1, 3); Brancheon : My_Graphs.Node := My_Graphs.Branch (One, 4, 3); begin - if Leafeon.Elements /= "abc" or Brancheon.Label /= One or - Leafeon.Start /= 1 or Brancheon.Start /= 4 or - Leafeon.Finish /= 3 or Brancheon.Finish /= 3 + if My_Graphs.Elements (Leafeon) /= "abc" or My_Graphs.Label (Brancheon) /= One or + My_Graphs.Start (Leafeon) /= 1 or My_Graphs.Start (Brancheon) /= 4 or + My_Graphs.Finish (Leafeon) /= 3 or My_Graphs.Finish (Brancheon) /= 3 then return Fail; end if; @@ -33,7 +33,9 @@ package body Graphs is function Empty_Check return Test_Result is begin - if not My_Graphs.Empty_Graph.Is_Empty or not My_Graphs.No_Position.Is_Nothing then + if not My_Graphs.Empty_Graph.Is_Empty or + not My_Graphs.Is_Nothing (My_Graphs.No_Position) + then return Fail; end if; return Pass; @@ -43,19 +45,19 @@ package body Graphs is function Attachment_Check return Test_Result is - Leaf1 : My_Graphs.Parse_Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 1, 3)); - Leaf2 : My_Graphs.Parse_Graph := My_Graphs.Singleton (My_Graphs.Leaf ("def", 4, 6)); - Leaf3 : My_Graphs.Parse_Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 4, 6)); - Leaf4 : My_Graphs.Parse_Graph := My_Graphs.Singleton (My_Graphs.Leaf ("def", 1, 3)); + Leaf1 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 1, 3)); + Leaf2 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("def", 4, 6)); + Leaf3 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 4, 6)); + Leaf4 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("def", 1, 3)); - Brancheon : My_Graphs.Parse_Graph := + Brancheon : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Branch (Three, 1, 15)); - Merge1 : My_Graphs.Parse_Graph := Leaf1; - Merge2 : My_Graphs.Parse_Graph := Leaf3; - Merge3 : My_Graphs.Parse_Graph := Brancheon; + Merge1 : My_Graphs.Graph := Leaf1; + Merge2 : My_Graphs.Graph := Leaf3; + Merge3 : My_Graphs.Graph := Brancheon; - Cursor1 : My_Interfaces.Cursor'Class := Merge3.Root (1); + Cursor1 : My_Graphs.Cursor := Merge3.Root (1); begin Merge1.Append (Leaf2); Merge2.Prepend (Leaf4); @@ -64,13 +66,19 @@ package body Graphs is if Merge1.Root_Count /= 2 or else Merge2.Root_Count /= 2 or else Merge3.Root_Count /= 1 or else - not Merge1.Root (1).Is_Leaf or else not Merge1.Root (2).Is_Leaf or else - Merge1.Root (1).Elements /= "abc" or else Merge1.Root (2).Elements /= "def" or else - not Merge2.Root (1).Is_Leaf or else not Merge2.Root (2).Is_Leaf or else - Merge2.Root (1).Elements /= "def" or else Merge2.Root (2).Elements /= "abc" or else - not Merge3.Root (1).Is_Branch or else - Cursor1.Label /= Three or else Cursor1.Child_Count /= 2 or else - Cursor1.First_Child.Elements /= "abc" or else Cursor1.Last_Child.Elements /= "def" + not My_Graphs.Is_Leaf (Merge1.Root (1)) or else + not My_Graphs.Is_Leaf (Merge1.Root (2)) or else + My_Graphs.Elements (Merge1.Root (1)) /= "abc" or else + My_Graphs.Elements (Merge1.Root (2)) /= "def" or else + not My_Graphs.Is_Leaf (Merge2.Root (1)) or else + not My_Graphs.Is_Leaf (Merge2.Root (2)) or else + My_Graphs.Elements (Merge2.Root (1)) /= "def" or else + My_Graphs.Elements (Merge2.Root (2)) /= "abc" or else + not My_Graphs.Is_Branch (Merge3.Root (1)) or else + My_Graphs.Label (Cursor1) /= Three or else + My_Graphs.Child_Count (Cursor1) /= 2 or else + My_Graphs.Elements (My_Graphs.First_Child (Cursor1)) /= "abc" or else + My_Graphs.Elements (My_Graphs.Last_Child (Cursor1)) /= "def" then return Fail; end if; @@ -81,13 +89,13 @@ package body Graphs is function Find_Check return Test_Result is - Leafeon : My_Graphs.Parse_Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 1, 3)); - Brancheon : My_Graphs.Parse_Graph := My_Graphs.Singleton (My_Graphs.Branch (One, 1, 5)); - Combined : My_Graphs.Parse_Graph := Brancheon; + Leafeon : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 1, 3)); + Brancheon : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Branch (One, 1, 5)); + Combined : My_Graphs.Graph := Brancheon; begin Combined.Attach_Choice (Combined.Root (1), Leafeon); declare - Expected_Result : My_Interfaces.Cursor'Class := Combined.Root (1).First_Child; + Expected_Result : My_Graphs.Cursor := My_Graphs.First_Child (Combined.Root (1)); begin if Combined.Find ("abc") /= Expected_Result or Combined.Find ("def") /= My_Graphs.No_Position or @@ -103,22 +111,22 @@ package body Graphs is function Find_Subgraph_Check return Test_Result is - Leafeon : My_Graphs.Parse_Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 1, 3)); - Branch1 : My_Graphs.Parse_Graph := My_Graphs.Singleton (My_Graphs.Branch (One, 1, 4)); - Branch2 : My_Graphs.Parse_Graph := My_Graphs.Singleton (My_Graphs.Branch (Two, 1, 5)); - Combined : My_Graphs.Parse_Graph := Branch2; + Leafeon : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 1, 3)); + Branch1 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Branch (One, 1, 4)); + Branch2 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Branch (Two, 1, 5)); + Combined : My_Graphs.Graph := Branch2; - My_Cursor : My_Interfaces.Cursor'Class := Combined.Root (1); + My_Cursor : My_Graphs.Cursor := Combined.Root (1); begin Combined.Attach_Choice (My_Cursor, Branch1); - My_Cursor := My_Cursor.First_Child; + My_Cursor := My_Graphs.First_Child (My_Cursor); Combined.Attach_Choice (My_Cursor, Leafeon); declare - Expected_Result : My_Interfaces.Cursor'Class := My_Cursor.First_Child; + Expected_Result : My_Graphs.Cursor := My_Graphs.First_Child (My_Cursor); begin - if My_Cursor.Find_In_Subgraph ("abc") /= Expected_Result or - My_Cursor.Find_In_Subgraph ("def") /= My_Graphs.No_Position + if My_Graphs.Find_In_Subgraph (My_Cursor, "abc") /= Expected_Result or + My_Graphs.Find_In_Subgraph (My_Cursor, "def") /= My_Graphs.No_Position then return Fail; end if; |