diff options
Diffstat (limited to 'src/kompsos-pretty_print.adb')
| -rw-r--r-- | src/kompsos-pretty_print.adb | 98 |
1 files changed, 94 insertions, 4 deletions
diff --git a/src/kompsos-pretty_print.adb b/src/kompsos-pretty_print.adb index 834c0ca..8d11f81 100644 --- a/src/kompsos-pretty_print.adb +++ b/src/kompsos-pretty_print.adb @@ -87,8 +87,6 @@ package body Kompsos.Pretty_Print is end Image; - - function Image (Item : in State) return String @@ -151,8 +149,6 @@ package body Kompsos.Pretty_Print is end Image; - - function Image (Item : in World) return String @@ -175,6 +171,100 @@ package body Kompsos.Pretty_Print is end Image; + + + procedure Do_Structure_DOT + (This : in World; + 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_World, Nodes, Next, Result); + if Nodes.Contains (This.Actual.Frs_World.Actual) then + SU.Append (Result, Latin.HT & + "n" & Image (Nodes.Element (This.Actual)) & " -> " & + "n" & Image (Nodes.Element (This.Actual.Frs_World.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_World, Nodes, Next, Result); + if Nodes.Contains (This.Actual.Uni_World.Actual) then + SU.Append (Result, Latin.HT & + "n" & Image (Nodes.Element (This.Actual)) & " -> " & + "n" & Image (Nodes.Element (This.Actual.Uni_World.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_World1, Nodes, Next, Result); + Do_Structure_DOT (This.Actual.Dis_World2, Nodes, Next, Result); + if Nodes.Contains (This.Actual.Dis_World1.Actual) then + SU.Append (Result, Latin.HT & + "n" & Image (Nodes.Element (This.Actual)) & " -> " & + "n" & Image (Nodes.Element (This.Actual.Dis_World1.Actual)) & + " [label=""1""];" & Latin.LF); + end if; + if Nodes.Contains (This.Actual.Dis_World2.Actual) then + SU.Append (Result, Latin.HT & + "n" & Image (Nodes.Element (This.Actual)) & " -> " & + "n" & Image (Nodes.Element (This.Actual.Dis_World2.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_World, Nodes, Next, Result); + if Nodes.Contains (This.Actual.Con_World.Actual) then + SU.Append (Result, Latin.HT & + "n" & Image (Nodes.Element (This.Actual)) & " -> " & + "n" & Image (Nodes.Element (This.Actual.Con_World.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_World, Nodes, Next, Result); + if Nodes.Contains (This.Actual.Rec_World.Actual) then + SU.Append (Result, Latin.HT & + "n" & Image (Nodes.Element (This.Actual)) & " -> " & + "n" & Image (Nodes.Element (This.Actual.Rec_World.Actual)) & ";" & Latin.LF); + end if; + end case; + end Do_Structure_DOT; + + + function Structure_DOT + (This : in World; + 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; |