1 files changed, 249 insertions, 0 deletions
diff --git a/src/packrat-parse_graphs.adb b/src/packrat-parse_graphs.adb
new file mode 100644
index 0000000..16b74dc
--- /dev/null
+++ b/src/packrat-parse_graphs.adb
@@ -0,0 +1,249 @@
+
+
+package body Packrat.Parse_Graphs is
+
+
+    function "<"
+           (Left, Right : in Edge_Label_Type)
+        return Boolean is
+    begin
+        if Left.Finish = Right.Finish then
+            return Left.Order < Right.Order;
+        else
+            return Left.Finish < Right.Finish;
+        end if;
+    end "<";
+
+
+
+
+
+    function "="
+           (Left, Right : in Parse_Graph)
+        return Boolean
+    is
+        use type Base.Graph;
+    begin
+        return Base.Graph (Left) = Base.Graph (Right) and
+            Left.Root_Node = Right.Root_Node;
+    end "=";
+
+
+
+
+
+    function To_Graph
+           (Nodes : in Node_Array;
+            Edges : in Edge_Array)
+        return Parse_Graph is
+    begin
+        return G : Parse_Graph :=
+            (Base.To_Graph (Nodes, Edges) with Root_Node => No_Node);
+    end To_Graph;
+
+
+    function To_Graph
+           (Nodes : in Node_Array;
+            Edges : in Edge_Array;
+            Root  : in Extended_Node_ID_Type)
+        return Parse_Graph
+    is
+        Valid : Boolean := False;
+    begin
+        if Root /= No_Node then
+            for N of Nodes loop
+                if Root = N then
+                    Valid := True;
+                    exit;
+                end if;
+            end loop;
+            if not Valid then
+                raise Constraint_Error with "Root node not in graph";
+            end if;
+        end if;
+        return G : Parse_Graph :=
+            (Base.To_Graph (Nodes, Edges) with Root_Node => Root);
+    end To_Graph;
+
+
+
+
+
+    procedure Assign
+           (Target : in out Parse_Graph;
+            Source : in     Parse_Graph) is
+    begin
+        Base.Assign (Base.Graph (Target), Base.Graph (Source));
+        Target.Root_Node := Source.Root_Node;
+    end Assign;
+
+
+    function Copy
+           (Source : in Parse_Graph)
+        return Parse_Graph is
+    begin
+        return G : Parse_Graph :=
+            (Base.Copy (Base.Graph (Source)) with Root_Node => Source.Root_Node);
+    end Copy;
+
+
+    procedure Move
+           (Target, Source : in out Parse_Graph) is
+    begin
+        Base.Move (Base.Graph (Target), Base.Graph (Source));
+        Target.Root_Node := Source.Root_Node;
+        Source.Root_Node := No_Node;
+    end Move;
+
+
+
+
+
+    function Root
+           (Container : in Parse_Graph)
+        return Cursor is
+    begin
+        if not Container.Contains (Container.Root_Node) then
+            return No_Element;
+        else
+            return Container.To_Cursor (Container.Root_Node);
+        end if;
+    end Root;
+
+
+    procedure Set_Root
+           (Container : in out Parse_Graph;
+            Node      : in     Extended_Node_ID_Type) is
+    begin
+        Container.Root_Node := Node;
+    end Set_Root;
+
+
+
+
+
+    function Finish_List
+           (Container : in Parse_Graph;
+            Node      : in Node_ID_Type)
+        return Finish_Array is
+    begin
+        return Finish_List (Container.To_Cursor (Node));
+    end Finish_List;
+
+
+    function Finish_List
+           (Position : in Cursor)
+        return Finish_Array
+    is
+        function V2A is new Vector_To_Array (Finish_Type, Finish_Array, Finish_Vectors);
+        Fins : Finish_Vectors.Vector;
+        Current : Edge_Label_Type;
+    begin
+        for E of Outbound (Position) loop
+            if Has_Label (Position, E) then
+                Current := Label (Position, E);
+                if not Fins.Contains (Current.Finish) then
+                    Fins.Append (Current.Finish);
+                end if;
+            end if;
+        end loop;
+        Finsort.Sort (Fins);
+        return V2A (Fins);
+    end Finish_List;
+
+
+    function Sub_Nodes
+           (Container : in Parse_Graph;
+            Node      : in Node_ID_Type;
+            Finish_At : in Finish_Type)
+        return Node_Array is
+    begin
+        return Sub_Nodes (Container.To_Cursor (Node), Finish_At);
+    end Sub_Nodes;
+
+
+    function Sub_Nodes
+           (Position  : in Cursor;
+            Finish_At : in Finish_Type)
+        return Node_Array
+    is
+        function V2A is new Vector_To_Array (Node_ID_Type, Node_Array, Node_Vectors);
+        Nodes : Node_Vectors.Vector;
+        Current_Label : Edge_Label_Type;
+    begin
+        for E of Outbound (Position) loop
+            if Has_Label (Position, E) then
+                Current_Label := Label (Position, E);
+                if Current_Label.Finish = Finish_At then
+                    Nodes.Reference (Current_Label.Order) := E.To;
+                end if;
+            end if;
+        end loop;
+        return V2A (Nodes);
+    end Sub_Nodes;
+
+
+
+
+
+    procedure Prune
+           (Container : in out Parse_Graph;
+            Node      : in     Node_ID_Type)
+    is
+        My_Cursor : Cursor := Container.To_Cursor (Node);
+    begin
+        Prune (My_Cursor);
+    end Prune;
+
+
+    procedure Prune
+           (Position : in out Cursor)
+    is
+        use type Ada.Containers.Count_Type;
+        Active : Cursor_Vectors.Vector;
+        Current : Cursor;
+    begin
+        if not Has_Element (Position) then
+            return;
+        end if;
+        for N of Children (Position) loop
+            if N /= Element (Position) then
+                Active.Append (Cursor_To (Position, N));
+            end if;
+        end loop;
+        Delete (Position);
+        while not Active.Is_Empty loop
+            for Index in reverse 1 .. Active.Last_Index loop
+                Current := Active (Index);
+                if Indegree (Current) = 0 then
+                    for N of Children (Current) loop
+                        if not Active.Contains (Cursor_To (Current, N)) then
+                            Active.Append (Cursor_To (Current, N));
+                        end if;
+                    end loop;
+                    Delete (Current);
+                end if;
+                Active.Delete (Index);
+            end loop;
+        end loop;
+    end Prune;
+
+
+
+
+
+    function Vector_To_Array
+           (Input : in Type_Vectors.Vector)
+        return Array_Type is
+    begin
+        return Result : Array_Type (1 .. Input.Last_Index) do
+            for I in Result'Range loop
+                Result (I) := Input (I);
+            end loop;
+        end return;
+    end Vector_To_Array;
+
+
+end Packrat.Parse_Graphs;
+
+