summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2019-02-04 19:09:12 +1100
committerJed Barber <jjbarber@y7mail.com>2019-02-04 19:09:12 +1100
commit68c27cc4e247466964f4b788e70e8453354051f9 (patch)
tree520e1470ad815af00899acfd6197292144e57495 /src
parent8eb1ca2817786f48385ba5f5baa43272de8d7eec (diff)
Reworked Graphs/Interfaces to avoid the Cursors and Nodes being tagged
Diffstat (limited to 'src')
-rw-r--r--src/packrat-graphs.adb461
-rw-r--r--src/packrat-graphs.ads381
-rw-r--r--src/packrat.ads341
3 files changed, 630 insertions, 553 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