-- Programmed by Jedidiah Barber -- Licensed under the Sunset License v1.0 -- See license.txt for further details with Ada.Characters.Latin_1, Ada.Strings.Fixed, Ada.Strings.Unbounded, Kompsos.Collector, System.Address_To_Access_Conversions, System.Storage_Elements; package body Kompsos.Pretty_Print is package Latin renames Ada.Characters.Latin_1; package Str renames Ada.Strings; package SU renames Ada.Strings.Unbounded; package Graph_Convert is new System.Address_To_Access_Conversions (Graph_Component); function "<" (Left, Right : in Graph_Component_Access) return Boolean is use System.Storage_Elements; begin return To_Integer (Graph_Convert.To_Address (Graph_Convert.Object_Pointer (Left))) < To_Integer (Graph_Convert.To_Address (Graph_Convert.Object_Pointer (Right))); end "<"; function Image (Item : in Long_Natural) return String is begin return Str.Fixed.Trim (Long_Natural'Image (Item), Str.Left); end Image; function Image (Item : in Variable) return String is begin return "Var#" & Image (Long_Natural (Item)); end Image; ----------------------------------- -- Datatype->String Conversion -- ----------------------------------- function Image (Item : in Integer) return String is begin return Str.Fixed.Trim (Integer'Image (Item), Str.Left); end Image; function Image (Item : in Term) return String is function Bare (Item : in Term) return String is begin case Item.Kind is when Null_Term => return "()"; when Atom_Term => return Element_Image (Item.Atom); when Var_Term => return Image (Item.Var); when Pair_Term => if Item.Right.Kind = Null_Term then return Image (Item.Left); elsif Item.Right.Kind /= Pair_Term then return Image (Item.Left) & " . " & Bare (Item.Right); else return Image (Item.Left) & " " & Bare (Item.Right); end if; end case; end Bare; begin if Item.Kind = Pair_Term then return "(" & Bare (Item) & ")"; else return Bare (Item); end if; end Image; function Image (Item : in State) return String is Result : SU.Unbounded_String; begin if Item.Ctrl.Actual = null then SU.Append (Result, Latin.HT & "N/A" & Latin.LF); else declare Marker : State_Component_Access := Item.Ctrl.Actual; begin while Marker /= null loop SU.Append (Result, Latin.HT & Image (Marker.Key) & " => " & Image (Marker.Value) & Latin.LF); Marker := Marker.Next.Ctrl.Actual; end loop; end; end if; return SU.To_String (Result); end Image; function Image (Item : in State_Array) return String is Result : SU.Unbounded_String; begin if Item'Length = 0 then return "States: N/A" & Latin.LF; end if; for Index in Item'Range loop SU.Append (Result, "State#" & Image (Index) & ":" & Latin.LF); SU.Append (Result, Image (Item (Index))); end loop; return SU.Slice (Result, 1, SU.Length (Result) - 1); end Image; function Image (Item : in Goal) return String is Result : SU.Unbounded_String; Counter : Positive := 1; package Collect is new Collector (Item, Empty_State); begin if not Collect.Has_Next then return "States: N/A" & Latin.LF; end if; loop SU.Append (Result, "State#" & Image (Counter) & ":" & Latin.LF); SU.Append (Result, Image (Collect.Next)); exit when not Collect.Has_Next; Counter := Counter + 1; end loop; return SU.Slice (Result, 1, SU.Length (Result) - 1); end Image; -------------------------------- -- Graphviz DAG Of Tomorrow -- -------------------------------- procedure Do_Structure_DOT (This : in Goal_Graph; Nodes : in out DOT_Node_Maps.Map; Next : in out Long_Natural; Result : in out SU.Unbounded_String) is begin if This.Actual = null or else Nodes.Contains (This.Actual) then return; end if; Nodes.Insert (This.Actual, Next); Next := Next + 1; case This.Actual.Kind is when Unify_Node => SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " [label=""unify""];" & Latin.LF); Do_Structure_DOT (This.Actual.Uni_Goal, Nodes, Next, Result); if Nodes.Contains (This.Actual.Uni_Goal.Actual) then SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " -> " & "n" & Image (Nodes.Element (This.Actual.Uni_Goal.Actual)) & ";" & Latin.LF); end if; when Disjunct_Node => SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " [label=""disjunct""];" & Latin.LF); Do_Structure_DOT (This.Actual.Dis_Goal1, Nodes, Next, Result); Do_Structure_DOT (This.Actual.Dis_Goal2, Nodes, Next, Result); if Nodes.Contains (This.Actual.Dis_Goal1.Actual) then SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " -> " & "n" & Image (Nodes.Element (This.Actual.Dis_Goal1.Actual)) & " [label=""1""];" & Latin.LF); end if; if Nodes.Contains (This.Actual.Dis_Goal2.Actual) then SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " -> " & "n" & Image (Nodes.Element (This.Actual.Dis_Goal2.Actual)) & " [label=""2""];" & Latin.LF); end if; when Conjunct_Node => SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " [label=""conjunct""];" & Latin.LF); Do_Structure_DOT (This.Actual.Con_Goal, Nodes, Next, Result); if Nodes.Contains (This.Actual.Con_Goal.Actual) then SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " -> " & "n" & Image (Nodes.Element (This.Actual.Con_Goal.Actual)) & ";" & Latin.LF); end if; when Recurse_Node => SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " [label=""recurse""];" & Latin.LF); Do_Structure_DOT (This.Actual.Rec_Goal, Nodes, Next, Result); if Nodes.Contains (This.Actual.Rec_Goal.Actual) then SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " -> " & "n" & Image (Nodes.Element (This.Actual.Rec_Goal.Actual)) & ";" & Latin.LF); end if; end case; end Do_Structure_DOT; function Structure_DOT (This : in Goal; Name : in String := "") return String is Result : SU.Unbounded_String; Nodes : DOT_Node_Maps.Map; Next_ID : Long_Natural := 0; begin SU.Append (Result, "digraph "); if Name /= "" then SU.Append (Result, Name & " "); end if; SU.Append (Result, "{" & Latin.LF); Do_Structure_DOT (This.Graph, Nodes, Next_ID, Result); SU.Append (Result, "}"); return SU.To_String (Result); end Structure_DOT; end Kompsos.Pretty_Print;