From 853a5a484f3e556a526473f23a60e3394b133abe Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 22 May 2020 22:23:22 +1000 Subject: Parse_Graphs complete but untested --- src/packrat-parse_graphs.adb | 249 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 249 insertions(+) create mode 100644 src/packrat-parse_graphs.adb (limited to 'src/packrat-parse_graphs.adb') 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; + + -- cgit