-- 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, Kompsos.Collector; package body Kompsos.Pretty_Print is package Latin renames Ada.Characters.Latin_1; package Str renames Ada.Strings; function Image (Item : in Integer) return String is begin return Str.Fixed.Trim (Integer'Image (Item), Str.Left); end Image; 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 "Vargen#" & Image (Long_Natural (Item.Ident)) & (if SU.Length (Item.Name) /= 0 then "/" & SU.To_String (Item.Name) else ""); 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 SU.Append (Result, Latin.HT & "Generation:"); if Item.Ident.Is_Empty then SU.Append (Result, " N/A" & Latin.LF); else SU.Append (Result, Latin.LF); for Iter in Item.Ident.Iterate loop SU.Append (Result, Latin.HT & Latin.HT & "Vargen#" & Image (Long_Natural (ID_Number_Maps.Key (Iter))) & " => " & Image (Long_Natural (ID_Number_Maps.Element (Iter))) & Latin.LF); end loop; end if; SU.Append (Result, Latin.HT & "Variables:"); if Item.LVars.Is_Empty then SU.Append (Result, " N/A" & Latin.LF); else SU.Append (Result, Latin.LF); for Index in Item.LVars.First_Index .. Item.LVars.Last_Index loop SU.Append (Result, Latin.HT & Latin.HT & "Var#" & Image (Long_Natural (Index)) & (if SU.Length (Item.LVars (Index)) /= 0 then "/" & SU.To_String (Item.LVars (Index)) else "") & Latin.LF); end loop; end if; SU.Append (Result, Latin.HT & "Substitution:"); if Item.Subst.Is_Empty then SU.Append (Result, " N/A" & Latin.LF); else SU.Append (Result, Latin.LF); for Iter in Item.Subst.Iterate loop SU.Append (Result, Latin.HT & Latin.HT & Image (Long_Natural (Binding_Maps.Key (Iter))) & " => " & Image (Binding_Maps.Element (Iter)) & Latin.LF); end loop; end if; return -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; procedure Do_Structure_DOT (This : in Goal; 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 Static_Node => SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " [label=""static""];" & Latin.LF); when Fresh_Node => SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " [label=""fresh""];" & Latin.LF); Do_Structure_DOT (This.Actual.Frs_Goal, Nodes, Next, Result); if Nodes.Contains (This.Actual.Frs_Goal.Actual) then SU.Append (Result, Latin.HT & "n" & Image (Nodes.Element (This.Actual)) & " -> " & "n" & Image (Nodes.Element (This.Actual.Frs_Goal.Actual)) & ";" & Latin.LF); end if; 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, Nodes, Next_ID, Result); SU.Append (Result, "}"); return SU.To_String (Result); end Structure_DOT; end Kompsos.Pretty_Print;