Can now output the basic structural DAG of a World in DOT format

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;