summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/packrat-graphs.adb1128
-rw-r--r--src/packrat-graphs.ads657
-rw-r--r--src/packrat-parse_graphs.ads9
3 files changed, 9 insertions, 1785 deletions
diff --git a/src/packrat-graphs.adb b/src/packrat-graphs.adb
deleted file mode 100644
index 10e130f..0000000
--- a/src/packrat-graphs.adb
+++ /dev/null
@@ -1,1128 +0,0 @@
-
-
-with
-
- Ada.Unchecked_Deallocation;
-
-
-package body Packrat.Graphs is
-
-
- procedure Free_Element_Array is new Ada.Unchecked_Deallocation
- (Element_Array, Element_Array_Access);
-
-
-
-
-
- function "<"
- (Left, Right : in Choice_Down)
- return Boolean is
- begin
- return Left.From < Right.From or else
- (Left.From = Right.From and Left.Choice < Right.Choice);
- end "<";
-
-
-
-
-
- procedure Adjust
- (This : in out Elem_Wrapper)
- is
- New_Array : Element_Array_Access;
- begin
- if This.Data /= null then
- New_Array := new Element_Array (This.Data'First .. This.Data'Last);
- New_Array.all := This.Data.all;
- This.Data := New_Array;
- end if;
- end Adjust;
-
-
- procedure Finalize
- (This : in out Elem_Wrapper) is
- begin
- if This.Data /= null then
- Free_Element_Array (This.Data);
- end if;
- end Finalize;
-
-
- function Wrap
- (Data : in Element_Array)
- return Elem_Wrapper
- is
- New_Array : Element_Array_Access :=
- new Element_Array (Data'First .. Data'Last);
- begin
- New_Array.all := Data;
- return (Ada.Finalization.Controlled with Data => New_Array);
- end Wrap;
-
-
-
-
-
- function Leaf
- (New_Item : in Element_Array;
- Start : in Positive;
- Finish : in Natural)
- return Node is
- begin
- return This : Node do
- This.Kind := Leaf_Node;
- This.Content := Wrap (New_Item);
- This.Start := Start;
- This.Finish := Finish;
- end return;
- end Leaf;
-
-
- function Branch
- (Label : in Label_Enum;
- Start : in Positive;
- Finish : in Natural)
- return Node is
- begin
- return This : Node do
- This.Kind := Branch_Node;
- This.Ident := Label;
- This.Start := Start;
- This.Finish := Finish;
- end return;
- end Branch;
-
-
-
-
-
- function Is_Nothing
- (This : in Node)
- return Boolean is
- begin
- return This.Kind = Null_Node;
- end Is_Nothing;
-
-
- function Is_Leaf
- (This : in Node)
- return Boolean is
- begin
- return This.Kind = Leaf_Node;
- end Is_Leaf;
-
-
- function Is_Branch
- (This : in Node)
- return Boolean is
- begin
- return This.Kind = Branch_Node;
- end Is_Branch;
-
-
-
-
-
- function Label
- (This : in Node)
- return Label_Enum is
- begin
- return This.Ident;
- end Label;
-
-
- function Elements
- (This : in Node)
- return Element_Array is
- begin
- return This.Content.Data.all;
- end Elements;
-
-
- function Start
- (This : in Node)
- return Positive is
- begin
- return This.Start;
- end Start;
-
-
- function Finish
- (This : in Node)
- return Natural is
- begin
- return This.Finish;
- end Finish;
-
-
-
-
-
- function Is_Nothing
- (Position : in Cursor)
- return Boolean is
- begin
- return Position.My_Graph = null or else
- Position.Index = 0 or else
- Position.Index > Position.My_Graph.all.Node_List.Last_Index or else
- Position.My_Graph.all.Node_List.Element (Position.Index).Kind = Null_Node;
- end Is_Nothing;
-
-
-
-
-
- function Depth
- (Position : in Cursor)
- return Natural is
- begin
- return Natural (Position.Track.Length);
- end Depth;
-
-
- function Is_Node
- (Position : in Cursor)
- return Boolean is
- begin
- return not Is_Nothing (Position);
- end Is_Node;
-
-
- function Is_Root
- (Position : in Cursor)
- return Boolean is
- begin
- return Position.My_Graph /= null and then
- Position.My_Graph.all.Root_List.Contains (Position.Index) and then
- Depth (Position) = 0;
- end Is_Root;
-
-
- function Is_Branch
- (Position : in Cursor)
- return Boolean is
- begin
- return Position.My_Graph /= null and then
- Position.Index /= 0 and then
- Position.Index <= Position.My_Graph.all.Node_List.Last_Index and then
- Position.My_Graph.all.Node_List.Element (Position.Index).Kind = Branch_Node;
- end Is_Branch;
-
-
- function Is_Leaf
- (Position : in Cursor)
- return Boolean is
- begin
- return Position.My_Graph /= null and then
- Position.Index /= 0 and then
- Position.Index <= Position.My_Graph.all.Node_List.Last_Index and then
- Position.My_Graph.all.Node_List.Element (Position.Index).Kind = Leaf_Node;
- end Is_Leaf;
-
-
- function Label
- (Position : in Cursor)
- return Label_Enum is
- begin
- return Position.My_Graph.all.Node_List.Element (Position.Index).Ident;
- end Label;
-
-
- function Elements
- (Position : in Cursor)
- return Element_Array is
- begin
- return Position.My_Graph.all.Node_List.Element (Position.Index).Content.Data.all;
- end Elements;
-
-
-
-
-
- function Start
- (Position : in Cursor)
- return Positive is
- begin
- return Position.My_Graph.all.Node_List.Element (Position.Index).Start;
- end Start;
-
-
- function Finish
- (Position : in Cursor)
- return Natural is
- begin
- return Position.My_Graph.all.Node_List.Element (Position.Index).Finish;
- end Finish;
-
-
- function Choices
- (My_Graph : in Graph;
- My_Index : in Node_Index)
- return Natural is
- begin
- if not My_Graph.Choices.Contains (My_Index) then
- return 0;
- else
- return My_Graph.Choices.Element (My_Index);
- end if;
- end Choices;
-
-
- function Choices
- (Position : in Cursor)
- return Natural is
- begin
- if not Is_Branch (Position) then
- return 0;
- else
- return Choices (Position.My_Graph.all, Position.Index);
- end if;
- end Choices;
-
-
-
-
-
- function Parent
- (Position : in Cursor)
- return Cursor is
- begin
- return Result : Cursor do
- Result.My_Graph := Position.My_Graph;
- Result.Track := Position.Track;
- if Natural (Position.Track.Length) = 0 then
- Result.Index := 0;
- else
- Result.Index := Position.Track.Last_Element.From;
- Result.Track.Delete_Last;
- end if;
- end return;
- end Parent;
-
-
- function Child_Count
- (Position : in Cursor;
- Choice : in Positive)
- return Natural is
- begin
- return Natural (Position.My_Graph.all.Down_Edges.Element ((Position.Index, Choice)).Length);
- end Child_Count;
-
-
- function Child_Count
- (Position : in Cursor)
- return Natural
- is
- Choice_Count : Natural := Choices (Position);
- begin
- if Choice_Count = 0 then
- return 0;
- else
- return Natural (Position.My_Graph.all.Down_Edges.Element
- ((Position.Index, Choice_Count)).Length);
- end if;
- end Child_Count;
-
-
- function All_Child_Count
- (Position : in Cursor)
- return Natural
- is
- Result : Natural := 0;
- begin
- for C in Integer range 1 .. Choices (Position) loop
- Result := Result + Child_Count (Position, C);
- end loop;
- return Result;
- end All_Child_Count;
-
-
- function First_Child
- (Position : in Cursor;
- Choice : in Positive)
- return Cursor is
- begin
- return Result : Cursor do
- Result.My_Graph := Position.My_Graph;
- Result.Index := Position.My_Graph.all.Down_Edges.Element
- ((Position.Index, Choice)).First_Element;
- Result.Track := Position.Track;
- Result.Track.Append ((Position.Index, Choice));
- end return;
- end First_Child;
-
-
- function Last_Child
- (Position : in Cursor;
- Choice : in Positive)
- return Cursor is
- begin
- return Result : Cursor do
- Result.My_Graph := Position.My_Graph;
- Result.Index := Position.My_Graph.all.Down_Edges.Element
- ((Position.Index, Choice)).Last_Element;
- Result.Track := Position.Track;
- Result.Track.Append ((Position.Index, Choice));
- end return;
- end Last_Child;
-
-
- function First_Child
- (Position : in Cursor)
- return Cursor
- is
- Choice : Natural := Choices (Position);
- begin
- return Result : Cursor do
- Result.My_Graph := Position.My_Graph;
- if Choice = 0 or Result.My_Graph = null then
- Result.Index := 0;
- else
- Result.Index := Position.My_Graph.all.Down_Edges.Element
- ((Position.Index, Choice)).First_Element;
- end if;
- Result.Track := Position.Track;
- Result.Track.Append ((Position.Index, Choice));
- end return;
- end First_Child;
-
-
- function Last_Child
- (Position : in Cursor)
- return Cursor
- is
- Choice : Natural := Choices (Position);
- begin
- return Result : Cursor do
- Result.My_Graph := Position.My_Graph;
- if Choice = 0 or Result.My_Graph = null then
- Result.Index := 0;
- else
- Result.Index := Position.My_Graph.all.Down_Edges.Element
- ((Position.Index, Choice)).Last_Element;
- end if;
- Result.Track := Position.Track;
- Result.Track.Append ((Position.Index, Choice));
- end return;
- end Last_Child;
-
-
- function Next_Sibling
- (Position : in Cursor)
- return Cursor
- is
- Parent_Index : Extended_Node_Index;
- Choice : Natural;
- Sibling : Index_Vectors.Cursor;
- begin
- if Depth (Position) = 0 then
- Parent_Index := 0;
- Choice := 0;
- else
- Parent_Index := Position.Track.Last_Element.From;
- Choice := Position.Track.Last_Element.Choice;
- end if;
- return Result : Cursor do
- Result.My_Graph := Position.My_Graph;
- if Choice = 0 or Parent_Index = 0 or Result.My_Graph = null or Position.Index = 0 then
- Result.Index := 0;
- else
- Sibling := Result.My_Graph.all.Down_Edges.Element
- ((Parent_Index, Choice)).Find (Position.Index);
- Index_Vectors.Next (Sibling);
- if Index_Vectors.Has_Element (Sibling) then
- Result.Index := Index_Vectors.Element (Sibling);
- else
- Result.Index := 0;
- end if;
- end if;
- Result.Track := Position.Track;
- end return;
- end Next_Sibling;
-
-
- function Prev_Sibling
- (Position : in Cursor)
- return Cursor
- is
- Parent_Index : Extended_Node_Index;
- Choice : Natural;
- Sibling : Index_Vectors.Cursor;
- begin
- if Depth (Position) = 0 then
- Parent_Index := 0;
- Choice := 0;
- else
- Parent_Index := Position.Track.Last_Element.From;
- Choice := Position.Track.Last_Element.Choice;
- end if;
- return Result : Cursor do
- Result.My_Graph := Position.My_Graph;
- if Choice = 0 or Parent_Index = 0 or Result.My_Graph = null or Position.Index = 0 then
- Result.Index := 0;
- else
- Sibling := Result.My_Graph.all.Down_Edges.Element
- ((Parent_Index, Choice)).Find (Position.Index);
- Index_Vectors.Previous (Sibling);
- if Index_Vectors.Has_Element (Sibling) then
- Result.Index := Index_Vectors.Element (Sibling);
- else
- Result.Index := 0;
- end if;
- end if;
- Result.Track := Position.Track;
- end return;
- end Prev_Sibling;
-
-
-
-
-
- procedure Delete_Loose_Subgraph
- (Container : in out Graph;
- Index : in Node_Index)
- is
- use type Ada.Containers.Count_Type;
- Number_Choices : Natural;
- begin
- if Container.Up_Edges.Contains (Index) and then
- Container.Up_Edges.Reference (Index).Length > 0
- then
- -- If this subgraph is still connected to the rest of the graph,
- -- then we do nothing.
- return;
- end if;
-
- if Container.Choices.Contains (Index) then
- Number_Choices := Container.Choices.Element (Index);
- else
- Number_Choices := 0;
- end if;
-
- for C in reverse Integer range 1 .. Number_Choices loop
- declare
- Edges : Edge_Down_Maps.Reference_Type :=
- Container.Down_Edges.Reference ((Index, C));
- begin
- for I in reverse Integer range 1 .. Edges.Last_Index loop
- declare
- Elem : Node_Index := Edges.Element.Element (I);
- begin
- Container.Delete_Up_Edge (Elem, Index);
- Container.Delete_Loose_Subgraph (Elem);
- end;
- end loop;
- end;
- Container.Delete_Down_Edges (Index, C);
- end loop;
-
- Container.Node_List.Reference (Index).Kind := Null_Node;
- if Index < Container.Add_Place then
- Container.Add_Place := Index;
- end if;
- while Container.Node_List.Length > 0 and then
- Container.Node_List.Last_Element.Kind = Null_Node
- loop
- Container.Node_List.Delete_Last;
- end loop;
-
- if Container.Root_List.Contains (Index) then
- Container.Root_List.Delete (Container.Root_List.Reverse_Find_Index (Index));
- end if;
- end Delete_Loose_Subgraph;
-
-
- procedure Delete_Up_Edge
- (Container : in out Graph;
- Current, Parent : in Node_Index)
- is
- Index_List : Edge_Up_Maps.Reference_Type :=
- Container.Up_Edges.Reference (Current);
- Place : Natural := Index_List.Reverse_Find_Index (Parent);
- begin
- Index_List.Delete (Place);
- if Index_List.Is_Empty then
- Container.Up_Edges.Delete (Current);
- end if;
- end Delete_Up_Edge;
-
-
- procedure Delete_Down_Edges
- (Container : in out Graph;
- From : in Node_Index;
- Choice : in Positive)
- is
- Number_Choices : Choice_Maps.Reference_Type := Container.Choices.Reference (From);
- begin
- for C in Integer range Choice + 1 .. Number_Choices loop
- Container.Down_Edges.Replace
- ((From, C - 1),
- Container.Down_Edges.Element ((From, C)));
- end loop;
- Container.Down_Edges.Delete ((From, Number_Choices));
- Number_Choices := Number_Choices - 1;
- if Number_Choices < 1 then
- Container.Choices.Delete (From);
- end if;
- end Delete_Down_Edges;
-
-
- procedure Delete_Children
- (Position : in out Cursor;
- Choice : in Positive)
- is
- use type Ada.Containers.Count_Type;
- Index_List : Edge_Down_Maps.Reference_Type :=
- Position.My_Graph.all.Down_Edges.Reference ((Position.Index, Choice));
- begin
- for I in reverse Integer range Index_List.First_Index .. Index_List.Last_Index loop
- declare
- Elem : Node_Index := Index_List.Element.Element (I);
- begin
- Position.My_Graph.all.Delete_Up_Edge (Elem, Position.Index);
- Position.My_Graph.all.Delete_Loose_Subgraph (Elem);
- end;
- end loop;
- Position.My_Graph.all.Delete_Down_Edges (Position.Index, Choice);
- while Position.My_Graph.all.Node_List.Length > 0 and then
- Position.My_Graph.all.Node_List.Last_Element.Kind = Null_Node
- loop
- Position.My_Graph.all.Node_List.Delete_Last;
- end loop;
- end Delete_Children;
-
-
- procedure Delete_Children
- (Position : in out Cursor)
- is
- Choice : Natural := Choices (Position);
- begin
- if Choice > 0 then
- Delete_Children (Position, Choice);
- end if;
- end Delete_Children;
-
-
- procedure Delete_All_Children
- (Position : in out Cursor) is
- begin
- for I in reverse Integer range 1 .. Choices (Position) loop
- Delete_Children (Position, I);
- end loop;
- end Delete_All_Children;
-
-
-
-
-
- function Equal_Subgraph
- (Left_Graph, Right_Graph : in Graph;
- Left_Index, Right_Index : in Node_Index)
- return Boolean
- is
- use type Ada.Containers.Count_Type;
- begin
- if Left_Graph.Node_List.Element (Left_Index) /=
- Right_Graph.Node_List.Element (Right_Index)
- then
- return False;
- end if;
-
- if Choices (Left_Graph, Left_Index) /=
- Choices (Right_Graph, Right_Index)
- then
- return False;
- end if;
-
- for C in Integer range 1 .. Choices (Left_Graph, Left_Index) loop
- declare
- Left_List : Edge_Down_Maps.Constant_Reference_Type :=
- Left_Graph.Down_Edges.Constant_Reference ((Left_Index, C));
- Right_List : Edge_Down_Maps.Constant_Reference_Type :=
- Right_Graph.Down_Edges.Constant_Reference ((Right_Index, C));
- begin
- if Left_List.Length /= Right_List.Length then
- return False;
- end if;
- for I in Integer range 1 .. Left_List.Last_Index loop
- if not Equal_Subgraph
- (Left_Graph,
- Right_Graph,
- Left_List.Element.Element (I),
- Right_List.Element.Element (I))
- then
- return False;
- end if;
- end loop;
- end;
- end loop;
-
- return True;
- end Equal_Subgraph;
-
-
- function Equal_Subgraph
- (Left, Right : in Cursor)
- return Boolean is
- begin
- return Equal_Subgraph
- (Left.My_Graph.all,
- Right.My_Graph.all,
- Left.Index,
- Right.Index);
- end Equal_Subgraph;
-
-
-
-
-
- function Node_Count
- (Container : in Graph;
- Root_List : in Index_Vectors.Vector)
- return Natural
- is
- Result : Natural := 0;
- Current_Vector : Index_Vectors.Vector := Root_List;
- New_Vector : Index_Vectors.Vector := Index_Vectors.Empty_Vector;
- begin
- while Natural (Current_Vector.Length) > 0 loop
- Result := Result + Natural (Current_Vector.Length);
- for N of Current_Vector loop
- if Is_Branch (Container.Node_List.Element (N)) and
- Container.Choices.Contains (N)
- then
- for C in Integer range 1 .. Container.Choices.Element (N) loop
- New_Vector.Append (Container.Down_Edges.Element ((N, C)));
- end loop;
- end if;
- end loop;
- Current_Vector := New_Vector;
- New_Vector.Clear;
- end loop;
- return Result;
- end Node_Count;
-
-
- function Subgraph_Node_Count
- (Position : in Cursor)
- return Natural
- is
- use type Index_Vectors.Vector;
- begin
- return Node_Count
- (Position.My_Graph.all,
- Index_Vectors.Empty_Vector & Position.Index);
- end Subgraph_Node_Count;
-
-
- function Find_In_Subgraph
- (Position : in Cursor;
- Item : in Element_Array)
- return Cursor is
- begin
- return This : Cursor;
- end Find_In_Subgraph;
-
-
-
-
-
- function Contains
- (Container : in Graph;
- Position : in Cursor)
- return Boolean is
- begin
- return Position.My_Graph = Container'Unrestricted_Access and then
- Position.Index < Container.Node_List.Last_Index and then
- Position.Index > 0 and then
- Container.Node_List.Element (Position.Index).Kind /= Null_Node;
- end Contains;
-
-
-
-
- function Singleton
- (Input : in Node)
- return Graph is
- begin
- return Result : Graph do
- Result.Root_List := Index_Vectors.Empty_Vector;
- Result.Root_List.Append (1);
- Result.Node_List := Node_Vectors.Empty_Vector;
- Result.Node_List.Append (Input);
- Result.Add_Place := 2;
- Result.Choices := Choice_Maps.Empty_Map;
- Result.Down_Edges := Edge_Down_Maps.Empty_Map;
- Result.Up_Edges := Edge_Up_Maps.Empty_Map;
- end return;
- end Singleton;
-
-
- function Node_At
- (Container : in Graph;
- Position : in Cursor)
- return Node_Reference is
- begin
- return (Data => No_Node'Unrestricted_Access);
- end Node_At;
-
-
-
-
-
- function Is_Empty
- (Container : in Graph)
- return Boolean is
- begin
- return Container.Root_List.Is_Empty;
- end Is_Empty;
-
-
- function Is_Ambiguous
- (Container : in Graph)
- return Boolean is
- begin
- if Natural (Container.Root_List.Length) > 1 then
- return True;
- end if;
- for N in Node_Index range 1 .. Container.Node_List.Last_Index loop
- if Container.Node_List.Element (N).Kind = Branch_Node and then
- Container.Choices.Contains (N) and then
- Container.Choices.Element (N) > 1
- then
- return True;
- end if;
- end loop;
- return False;
- end Is_Ambiguous;
-
-
- function Node_Count
- (Container : in Graph)
- return Natural is
- begin
- return Node_Count (Container, Container.Root_List);
- end Node_Count;
-
-
-
-
-
- function Root_Count
- (Container : in Graph)
- return Natural is
- begin
- return Natural (Container.Root_List.Length);
- end Root_Count;
-
-
- function Root
- (Container : in Graph;
- Index : in Positive)
- return Cursor is
- begin
- return Result : Cursor do
- Result.My_Graph := Container'Unrestricted_Access;
- Result.Index := Container.Root_List.Element (Index);
- Result.Track := Choice_Down_Vectors.Empty_Vector;
- end return;
- end Root;
-
-
-
-
-
- procedure Add_Nodes
- (Container : in out Graph;
- Addition : in Node_Vectors.Vector;
- Mapping : out Index_Maps.Map) is
- begin
- Mapping := Index_Maps.Empty_Map;
- for C in Addition.Iterate loop
- Mapping.Insert (Node_Vectors.To_Index (C), Container.Add_Place);
- if Container.Add_Place > Container.Node_List.Last_Index then
- Container.Node_List.Append (Node_Vectors.Element (C));
- else
- Container.Node_List.Replace_Element (Container.Add_Place, Node_Vectors.Element (C));
- end if;
- while Container.Add_Place <= Container.Node_List.Last_Index and then
- not Is_Nothing (Container.Node_List.Element (Container.Add_Place))
- loop
- Container.Add_Place := Container.Add_Place + 1;
- end loop;
- end loop;
- end Add_Nodes;
-
-
- procedure Add_Edges
- (Container : in out Graph;
- Addition : in Graph;
- Mapping : in Index_Maps.Map)
- is
- Targets : Index_Vectors.Vector := Index_Vectors.Empty_Vector;
- begin
- -- Up edges
- for E in Addition.Up_Edges.Iterate loop
- Targets.Clear;
- for T of Edge_Up_Maps.Element (E) loop
- Targets.Append (Mapping.Element (T));
- end loop;
- Container.Up_Edges.Insert
- (Mapping.Element (Edge_Up_Maps.Key (E)), Targets);
- end loop;
-
- -- Down edges
- for E in Addition.Down_Edges.Iterate loop
- Targets.Clear;
- for T of Edge_Down_Maps.Element (E) loop
- Targets.Append (Mapping.Element (T));
- end loop;
- Container.Down_Edges.Insert
- ((Mapping.Element (Edge_Down_Maps.Key (E).From), Edge_Down_Maps.Key (E).Choice),
- Targets);
- end loop;
-
- -- Choices
- for C in Addition.Choices.Iterate loop
- Container.Choices.Insert
- (Mapping.Element (Choice_Maps.Key (C)), Choice_Maps.Element (C));
- end loop;
- end Add_Edges;
-
-
- procedure Append
- (Container : in out Graph;
- Addition : in Graph)
- is
- Mapping : Index_Maps.Map;
- begin
- -- Add the nodes and edges from the addition to the graph,
- -- making sure to handle the conversion of the index each node
- -- is stored at. If index conversion wasn't required this bit would
- -- be much simpler.
- Add_Nodes (Container, Addition.Node_List, Mapping);
- Add_Edges (Container, Addition, Mapping);
-
- -- Append the root list of the addition to the graph
- for R of Addition.Root_List loop
- Container.Root_List.Append (Mapping.Element (R));
- end loop;
- end Append;
-
-
- procedure Prepend
- (Container : in out Graph;
- Addition : in Graph)
- is
- Mapping : Index_Maps.Map;
- Converted_Roots : Index_Vectors.Vector := Index_Vectors.Empty_Vector;
- begin
- -- Add the nodes and edges from the addition to the graph,
- -- making sure to handle the conversion of the index each node
- -- is stored at. If index conversion wasn't required this bit would
- -- be much simpler.
- Add_Nodes (Container, Addition.Node_List, Mapping);
- Add_Edges (Container, Addition, Mapping);
-
- -- Prepend the root list of the addition to the graph
- for R of Addition.Root_List loop
- Converted_Roots.Append (Mapping.Element (R));
- end loop;
- Container.Root_List.Prepend (Converted_Roots);
- end Prepend;
-
-
- procedure Attach_Choice
- (Container : in out Graph;
- Position : in Cursor;
- Addition : in Graph) is
- begin
- null;
- end Attach_Choice;
-
-
-
-
-
- procedure Clear
- (Container : in out Graph) is
- begin
- Container.Root_List.Clear;
- Container.Node_List.Clear;
- Container.Add_Place := 1;
- Container.Choices.Clear;
- Container.Down_Edges.Clear;
- Container.Up_Edges.Clear;
- end Clear;
-
-
- procedure Delete_Position
- (Container : in out Graph;
- Position : in out Cursor)
- is
- use type Ada.Containers.Count_Type;
- begin
- if Position.Track.Length > 0 then
- Delete_Up_Edge (Container, Position.Index, Position.Track.Last_Element.From);
- declare
- Last : Choice_Down :=
- Position.Track.Last_Element;
- Ref : Edge_Down_Maps.Reference_Type :=
- Container.Down_Edges.Reference (Last);
- Number_Choices : Choice_Maps.Reference_Type :=
- Container.Choices.Reference (Last.From);
- begin
- Ref.Delete (Ref.Find_Index (Position.Index));
- if Ref.Length = 0 then
- for C in Integer range Last.Choice + 1 .. Number_Choices loop
- Container.Down_Edges.Replace
- ((Last.From, C - 1),
- Container.Down_Edges.Element ((Last.From, C)));
- end loop;
- Container.Down_Edges.Delete ((Last.From, Number_Choices));
- Number_Choices := Number_Choices - 1;
- if Number_Choices < 1 then
- Container.Choices.Delete (Last.From);
- end if;
- end if;
- end;
- end if;
- Delete_Loose_Subgraph (Container, Position.Index);
- while Position.My_Graph.all.Node_List.Length > 0 and then
- Position.My_Graph.all.Node_List.Last_Element.Kind = Null_Node
- loop
- Position.My_Graph.all.Node_List.Delete_Last;
- end loop;
- end Delete_Position;
-
-
-
-
-
- function Find
- (Container : in Graph;
- Item : in Element_Array)
- return Cursor is
- begin
- return This : Cursor;
- end Find;
-
-
-
-
-
- function Default_Choices
- (Container : in Graph;
- Position : in Cursor)
- return Natural is
- begin
- if Is_Nothing (Position) then
- return Container.Root_Count;
- else
- return Choices (Position);
- end if;
- end Default_Choices;
-
-
- function Accept_All
- (Position : in Cursor)
- return Boolean is
- begin
- return not Is_Nothing (Position);
- end Accept_All;
-
-
-
-
-
- function Iterate
- (Container : in Graph;
- Start_At : in Cursor := No_Position;
- Choose : in Choosing_Function := Default_Choices'Access;
- Filter : in Filter_Function := Accept_All'Access)
- return Graph_Iterators.Reversible_Iterator'Class is
- begin
- return This : Reversible_Iterator do
- This.My_Graph := Container'Unrestricted_Access;
- This.Start_Pos := Start_At;
- This.Rule := Specific_Branch;
- This.Choose_Func := Choose;
- This.Filter_Func := Filter;
- end return;
- end Iterate;
-
-
- function Iterate_All
- (Container : in Graph;
- Start_At : in Cursor := No_Position;
- Filter : in Filter_Function := Accept_All'Access)
- return Graph_Iterators.Reversible_Iterator'Class is
- begin
- return This : Reversible_Iterator do
- This.My_Graph := Container'Unrestricted_Access;
- This.Start_Pos := Start_At;
- This.Rule := All_Nodes;
- This.Choose_Func := null;
- This.Filter_Func := Filter;
- end return;
- end Iterate_All;
-
-
-
-
-
- function First
- (Object : in Reversible_Iterator)
- return Cursor is
- begin
- if Object.My_Graph = null or else Object.My_Graph.all.Is_Empty then
- return No_Position;
- elsif Is_Nothing (Object.Start_Pos) then
- if Object.Rule = All_Nodes then
- return Object.My_Graph.all.Root (1);
- else
- return Object.My_Graph.all.Root
- (Object.Choose_Func (Object.My_Graph.all, No_Position));
- end if;
- else
- return Object.Start_Pos;
- end if;
- end First;
-
-
- function Next
- (Object : in Reversible_Iterator;
- Place : in Cursor)
- return Cursor is
- begin
- if Object.My_Graph = null or else
- Object.My_Graph.all.Is_Empty or else
- Is_Nothing (Place)
- then
- return No_Position;
- end if; -- elsif
- return No_Position;
- end Next;
-
-
- function Last
- (Object : in Reversible_Iterator)
- return Cursor is
- begin
- return No_Position;
- end Last;
-
-
- function Previous
- (Object : in Reversible_Iterator;
- Place : in Cursor)
- return Cursor is
- begin
- return No_Position;
- end Previous;
-
-
-end Packrat.Graphs;
-
-
diff --git a/src/packrat-graphs.ads b/src/packrat-graphs.ads
deleted file mode 100644
index 6bceaaf..0000000
--- a/src/packrat-graphs.ads
+++ /dev/null
@@ -1,657 +0,0 @@
-
-
-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;
-package Packrat.Graphs is
-
-
- type Node is private;
-
- type Node_Reference (Data : not null access Node) is limited null record
- with Implicit_Dereference => Data;
-
- type Cursor is private;
-
- type Graph is tagged private
- with Default_Iterator => Iterate,
- Iterator_Element => Node_Reference,
- Variable_Indexing => Node_At;
-
-
-
-
- No_Position : constant Cursor;
-
- Empty_Graph : constant Graph;
-
-
-
-
- function Leaf
- (New_Item : in Element_Array;
- Start : in Positive;
- Finish : in Natural)
- 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
- with Pre =>
- Finish + 1 >= Start,
- Post =>
- Is_Branch (Branch'Result);
-
-
-
-
- function Is_Leaf
- (This : in Node)
- return Boolean;
-
- function Is_Branch
- (This : in Node)
- return Boolean;
-
-
-
-
- function Label
- (This : in Node)
- return Label_Enum
- with Pre =>
- Is_Branch (This);
-
- function Elements
- (This : in Node)
- return Element_Array
- with Pre =>
- Is_Leaf (This);
-
- function Start
- (This : in Node)
- return Positive;
-
- function Finish
- (This : in Node)
- return Natural;
-
-
-
-
- function Is_Nothing
- (Position : in Cursor)
- return Boolean;
-
-
-
-
- function Depth
- (Position : in Cursor)
- return Natural;
-
- function Is_Node
- (Position : in Cursor)
- return Boolean
- with Post =>
- (if Is_Node'Result then not Is_Nothing (Position));
-
- function Is_Root
- (Position : in Cursor)
- 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
- with Post =>
- (if Is_Branch'Result then not Is_Nothing (Position));
-
- function Is_Leaf
- (Position : in Cursor)
- return Boolean
- with Post =>
- (if Is_Leaf'Result then not Is_Nothing (Position));
-
-
-
-
- function Label
- (Position : in Cursor)
- return Label_Enum
- with Pre =>
- Is_Branch (Position);
-
- function Elements
- (Position : in Cursor)
- return Element_Array
- with Pre =>
- Is_Leaf (Position);
-
- function Start
- (Position : in Cursor)
- return Positive
- with Pre =>
- not Is_Nothing (Position);
-
- function Finish
- (Position : in Cursor)
- return Natural
- with Pre =>
- not Is_Nothing (Position);
-
- function Choices
- (Position : in Cursor)
- return Natural;
-
-
-
-
- function Parent
- (Position : in Cursor)
- return Cursor;
-
- function Child_Count
- (Position : in Cursor;
- Choice : in Positive)
- return Natural
- with Pre =>
- Choice <= Choices (Position);
-
- function Child_Count
- (Position : in Cursor)
- return Natural;
-
- function All_Child_Count
- (Position : in Cursor)
- return Natural;
-
- function First_Child
- (Position : in Cursor;
- Choice : in Positive)
- return Cursor
- with Pre =>
- Choice <= Choices (Position),
- Post =>
- Parent (First_Child'Result) = Position;
-
- function Last_Child
- (Position : in Cursor;
- Choice : in Positive)
- return Cursor
- with Pre =>
- Choice <= Choices (Position),
- Post =>
- Parent (Last_Child'Result) = Position;
-
- function First_Child
- (Position : in Cursor)
- return Cursor
- with Post =>
- Parent (First_Child'Result) = Position;
-
- function Last_Child
- (Position : in Cursor)
- return Cursor
- with Post =>
- Parent (Last_Child'Result) = Position;
-
- function Next_Sibling
- (Position : in Cursor)
- return Cursor
- with Post =>
- Parent (Next_Sibling'Result) = Parent (Position);
-
- function Prev_Sibling
- (Position : in Cursor)
- return Cursor
- with Post =>
- Parent (Prev_Sibling'Result) = Parent (Position);
-
- procedure Delete_Children
- (Position : in out Cursor;
- Choice : in Positive)
- with Pre =>
- Choice <= Choices (Position),
- Post =>
- Child_Count (Position, Choice) = 0;
-
- procedure Delete_Children
- (Position : in out Cursor)
- with Post =>
- Child_Count (Position) = 0;
-
- procedure Delete_All_Children
- (Position : in out Cursor)
- with Post =>
- All_Child_Count (Position) = 0;
-
-
-
-
- function Equal_Subgraph
- (Left, Right : in Cursor)
- return Boolean
- with Pre =>
- Is_Node (Left) and Is_Node (Right);
-
- function Subgraph_Node_Count
- (Position : in Cursor)
- return Natural;
-
- function Find_In_Subgraph
- (Position : in Cursor;
- Item : in Element_Array)
- return Cursor
- with Post =>
- Is_Nothing (Find_In_Subgraph'Result) or
- Is_Leaf (Find_In_Subgraph'Result);
-
-
-
-
- function Contains
- (Container : in Graph;
- Position : in Cursor)
- return Boolean
- with Post =>
- (if Contains'Result then not Is_Nothing (Position));
-
-
-
-
- function Singleton
- (Input : in Node)
- return Graph
- with Post =>
- Singleton'Result.Node_Count = 1;
-
- function Node_At
- (Container : in Graph;
- Position : in Cursor)
- return Node_Reference
- with Pre =>
- Contains (Container, Position);
-
-
-
-
- function Is_Empty
- (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 Graph)
- return Boolean;
-
- function Node_Count
- (Container : in Graph)
- return Natural;
-
-
-
-
- function Root_Count
- (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 Graph;
- Index : in Positive)
- return Cursor
- with Pre =>
- Index <= Container.Root_Count;
-
-
-
-
- procedure Append
- (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 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 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 Graph)
- with Post =>
- Container.Is_Empty;
-
- procedure Delete_Position
- (Container : in out Graph;
- Position : in out Cursor)
- with Pre'Class =>
- Container.Contains (Position),
- Post'Class =>
- not Container.Contains (Position);
-
-
-
-
- function Find
- (Container : in Graph;
- Item : in Element_Array)
- return Cursor
- with Post =>
- Is_Leaf (Find'Result) or
- Is_Nothing (Find'Result);
-
-
-
-
- package Graph_Iterators is
- new Ada.Iterator_Interfaces (Cursor, Is_Node);
-
- -- Note that if the given Cursor doesn't point to any position,
- -- then the function should assume that the choice is of what root to
- -- select and return that value.
- type Choosing_Function is access function
- (Container : in Graph;
- Position : in Cursor)
- return Natural;
-
- -- This function returns True if a Node pointed to by a Cursor should
- -- be returned, and False if it should be ignored. An example of a
- -- filter that will probably see a decent amount of use would be Is_Leaf.
- type Filter_Function is access function
- (Position : in Cursor)
- return Boolean;
-
-
-
-
- function Default_Choices
- (Container : in Graph;
- Position : in Cursor)
- return Natural;
-
- function Accept_All
- (Position : in Cursor)
- return Boolean;
-
-
-
-
- function Iterate
- (Container : in Graph;
- Start_At : in Cursor := No_Position;
- Choose : in Choosing_Function := Default_Choices'Access;
- Filter : in Filter_Function := Accept_All'Access)
- return Graph_Iterators.Reversible_Iterator'Class
- with Pre =>
- Container.Contains (Start_At) or Is_Nothing (Start_At);
-
- function Iterate_All
- (Container : in Graph;
- Start_At : in Cursor := No_Position;
- Filter : in Filter_Function := Accept_All'Access)
- return Graph_Iterators.Reversible_Iterator'Class
- with Pre =>
- Container.Contains (Start_At) or Is_Nothing (Start_At);
-
-
-
-
-private
-
-
- subtype Node_Index is Positive;
- subtype Extended_Node_Index is Natural;
-
-
-
-
- function Choices
- (My_Graph : in Graph;
- My_Index : in Node_Index)
- return Natural
- with Pre =>
- My_Index <= My_Graph.Node_List.Last_Index;
-
-
- procedure Delete_Loose_Subgraph
- (Container : in out Graph;
- Index : in Node_Index)
- with Pre =>
- Index <= Container.Node_List.Last_Index and then
- Container.Node_List.Element (Index).Kind /= Null_Node;
-
- procedure Delete_Up_Edge
- (Container : in out Graph;
- Current, Parent : in Node_Index)
- with Pre =>
- Container.Up_Edges.Contains (Current) and then
- Container.Up_Edges.Reference (Current).Contains (Parent);
-
- procedure Delete_Down_Edges
- (Container : in out Graph;
- From : in Node_Index;
- Choice : in Positive)
- with Pre =>
- Container.Choices.Contains (From) and then
- Container.Choices.Element (From) > 0 and then
- Container.Down_Edges.Contains ((From, Choice)),
- Post =>
- not Container.Down_Edges.Contains ((From, Choice));
-
-
- function Equal_Subgraph
- (Left_Graph, Right_Graph : in Graph;
- Left_Index, Right_Index : in Node_Index)
- return Boolean
- with Pre =>
- Left_Index <= Left_Graph.Node_List.Last_Index and
- Right_Index <= Right_Graph.Node_List.Last_Index;
-
-
-
-
- package Index_Vectors is new Ada.Containers.Vectors
- (Index_Type => Positive,
- Element_Type => Node_Index);
-
- package Index_Maps is new Ada.Containers.Ordered_Maps
- (Key_Type => Node_Index,
- Element_Type => Node_Index);
-
-
-
-
- function Node_Count
- (Container : in Graph;
- Root_List : in Index_Vectors.Vector)
- return Natural;
-
-
-
-
- type Choice_Down is record
- From : Extended_Node_Index;
- Choice : Natural;
- 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 record
- My_Graph : access Graph;
- Index : Extended_Node_Index;
- Track : Choice_Down_Vectors.Vector;
- end 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 :=
- (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 Iterate_Kind is (Specific_Branch, All_Nodes);
-
- type Reversible_Iterator is new Graph_Iterators.Reversible_Iterator with record
- My_Graph : access Graph;
- Start_Pos : Cursor;
- Rule : Iterate_Kind;
- Choose_Func : Choosing_Function;
- Filter_Func : Filter_Function;
- end record;
-
- overriding function First
- (Object : in Reversible_Iterator)
- return Cursor;
-
- overriding function Next
- (Object : in Reversible_Iterator;
- Place : in Cursor)
- return Cursor;
-
- overriding function Last
- (Object : in Reversible_Iterator)
- return Cursor;
-
- overriding function Previous
- (Object : in Reversible_Iterator;
- Place : in Cursor)
- return Cursor;
-
-
-end Packrat.Graphs;
-
-
diff --git a/src/packrat-parse_graphs.ads b/src/packrat-parse_graphs.ads
index 0a3660e..d9cde0b 100644
--- a/src/packrat-parse_graphs.ads
+++ b/src/packrat-parse_graphs.ads
@@ -180,6 +180,15 @@ package Packrat.Parse_Graphs is
+ -- Other things needed here...
+ -- Equal_Subgraph? (in Directed_Graph lib)
+ -- Is_Ambiguous?
+ -- Iterate_Short, Iterate_Long, Iterate_By
+ -- Choosing and Filtering functions for Iterate_By
+
+
+
+
-- Since this package sets the Nodes, Edges, and Labels of the Graphs
-- to be specific types, it cannot be a child package of Directed_Graphs.
-- Yet, it still is an extension of that package. To make it all work