Improved memory management for world gen

2 files changed, 106 insertions, 101 deletions

diff --git a/src/kompsos.adb b/src/kompsos.adb
index 99c8ad9..cb2f775 100644
--- a/src/kompsos.adb
+++ b/src/kompsos.adb
@@ -56,53 +56,50 @@ package body Kompsos is
 
 
 
-    --  Mu_Worlds  --
+    --  World_Holders  --
 
     procedure Free is new Ada.Unchecked_Deallocation (Mu_World'Class, World_Access);
 
 
+    procedure Initialize
+           (This : in out World_Holder) is
+    begin
+        This.Ptr := null;
+    end Initialize;
+
+
     procedure Adjust
-           (This : in out Mu_World) is
+           (This : in out World_Holder) is
     begin
-        case This.Engine.Kind is
-        when No_Gen =>
-            null;
-        when Fresh_Gen =>
-            This.Engine.Frs_World := new Mu_World'Class'(This.Engine.Frs_World.all);
-        when Unify_Gen =>
-            This.Engine.Uni_World := new Mu_World'Class'(This.Engine.Uni_World.all);
-        when Buffer_Gen =>
-            This.Engine.Buff_World := new Mu_World'Class'(This.Engine.Buff_World.all);
-        when Disjunct_Gen =>
-            This.Engine.Dis_World1 := new Mu_World'Class'(This.Engine.Dis_World1.all);
-            This.Engine.Dis_World2 := new Mu_World'Class'(This.Engine.Dis_World2.all);
-        when Recurse_Gen =>
-            This.Engine.Rec_World := new Mu_World'Class'(This.Engine.Rec_World.all);
-        end case;
+        This.Ptr := new Mu_World'Class'(This.Ptr.all);
     end Adjust;
 
 
     procedure Finalize
-           (This : in out Mu_World) is
+           (This : in out World_Holder) is
     begin
-        case This.Engine.Kind is
-        when No_Gen =>
-            null;
-        when Fresh_Gen =>
-            Free (This.Engine.Frs_World);
-        when Unify_Gen =>
-            Free (This.Engine.Uni_World);
-        when Buffer_Gen =>
-            Free (This.Engine.Buff_World);
-        when Disjunct_Gen =>
-            Free (This.Engine.Dis_World1);
-            Free (This.Engine.Dis_World2);
-        when Recurse_Gen =>
-            Free (This.Engine.Rec_World);
-        end case;
+        Free (This.Ptr);
     end Finalize;
 
 
+    function Hold
+           (This : in Mu_World'Class)
+        return World_Holder is
+    begin
+        return (Ada.Finalization.Controlled with Ptr => new Mu_World'Class'(This));
+    end Hold;
+
+
+    procedure Swap
+           (Left, Right : in out World_Holder)
+    is
+        Temp_Ptr : World_Access := Left.Ptr;
+    begin
+        Left.Ptr := Right.Ptr;
+        Right.Ptr := Temp_Ptr;
+    end Swap;
+
+
 
 
     -------------
@@ -360,15 +357,15 @@ package body Kompsos is
     procedure Roll_Fresh_Gen
            (This : in out Mu_World) is
     begin
-        This.Engine.Frs_World.Rollover;
-        for Potential of This.Engine.Frs_World.Possibles loop
-            Potential.LVars.Insert (This.Engine.Frs_World.Next_Ident, This.Engine.Frs_Name);
+        This.Engine.Frs_World.Ptr.Rollover;
+        for Potential of This.Engine.Frs_World.Ptr.Possibles loop
+            Potential.LVars.Insert (This.Engine.Frs_World.Ptr.Next_Ident, This.Engine.Frs_Name);
             This.Possibles.Append (Potential);
         end loop;
-        if This.Engine.Frs_World.Engine.Kind = No_Gen then
+        if This.Engine.Frs_World.Ptr.Engine.Kind = No_Gen then
             This.Engine := (Kind => No_Gen);
         else
-            This.Engine.Frs_World.Possibles.Clear;
+            This.Engine.Frs_World.Ptr.Possibles.Clear;
         end if;
     end Roll_Fresh_Gen;
 
@@ -378,16 +375,16 @@ package body Kompsos is
     is
         Extended : State;
     begin
-        This.Engine.Uni_World.Rollover;
-        for Potential of This.Engine.Uni_World.Possibles loop
+        This.Engine.Uni_World.Ptr.Rollover;
+        for Potential of This.Engine.Uni_World.Ptr.Possibles loop
             if Do_Unify (Potential, This.Engine.Uni_Term1, This.Engine.Uni_Term2, Extended) then
                 This.Possibles.Append (Extended);
             end if;
         end loop;
-        if This.Engine.Uni_World.Engine.Kind = No_Gen then
+        if This.Engine.Uni_World.Ptr.Engine.Kind = No_Gen then
             This.Engine := (Kind => No_Gen);
         else
-            This.Engine.Uni_World.Possibles.Clear;
+            This.Engine.Uni_World.Ptr.Possibles.Clear;
         end if;
     end Roll_Unify_Gen;
 
@@ -395,30 +392,26 @@ package body Kompsos is
     procedure Roll_Buffer_Gen
            (This : in out Mu_World) is
     begin
-        This.Engine.Buff_World.Rollover;
-        This.Possibles.Append (This.Engine.Buff_World.Possibles);
-        if This.Engine.Buff_World.Engine.Kind = No_Gen then
+        This.Engine.Buff_World.Ptr.Rollover;
+        This.Possibles.Append (This.Engine.Buff_World.Ptr.Possibles);
+        if This.Engine.Buff_World.Ptr.Engine.Kind = No_Gen then
             This.Engine := (Kind => No_Gen);
         else
-            This.Engine.Buff_World.Possibles.Clear;
+            This.Engine.Buff_World.Ptr.Possibles.Clear;
         end if;
     end Roll_Buffer_Gen;
 
 
     procedure Roll_Disjunct_Gen
-           (This : in out Mu_World)
-    is
-        Temp_World : World_Access;
+           (This : in out Mu_World) is
     begin
-        This.Engine.Dis_World1.Rollover;
-        This.Possibles.Append (This.Engine.Dis_World1.Possibles);
-        if This.Engine.Dis_World1.Engine.Kind = No_Gen then
+        This.Engine.Dis_World1.Ptr.Rollover;
+        This.Possibles.Append (This.Engine.Dis_World1.Ptr.Possibles);
+        if This.Engine.Dis_World1.Ptr.Engine.Kind = No_Gen then
             This.Engine := (Kind => Buffer_Gen, Buff_World => This.Engine.Dis_World2);
         else
-            This.Engine.Dis_World1.Possibles.Clear;
-            Temp_World := This.Engine.Dis_World1;
-            This.Engine.Dis_World1 := This.Engine.Dis_World2;
-            This.Engine.Dis_World2 := Temp_World;
+            This.Engine.Dis_World1.Ptr.Possibles.Clear;
+            Swap (This.Engine.Dis_World1, This.Engine.Dis_World2);
         end if;
     end Roll_Disjunct_Gen;
 
@@ -426,9 +419,9 @@ package body Kompsos is
     procedure Roll_Recurse_Gen
            (This : in out Mu_World) is
     begin
-        This.Engine.Rec_World.Rollover;
-        if This.Engine.Rec_World.Possibles.Last_Index < This.Engine.Rec_Index then
-            if This.Engine.Rec_World.Engine.Kind = No_Gen then
+        This.Engine.Rec_World.Ptr.Rollover;
+        if This.Engine.Rec_World.Ptr.Possibles.Last_Index < This.Engine.Rec_Index then
+            if This.Engine.Rec_World.Ptr.Engine.Kind = No_Gen then
                 if This.Engine.Rec_Index = 1 then
                     This.Engine := (Kind => No_Gen);
                 else
@@ -438,11 +431,11 @@ package body Kompsos is
             return;
         end if;
         for Index in Integer range
-            This.Engine.Rec_Index .. This.Engine.Rec_World.Possibles.Last_Index
+            This.Engine.Rec_Index .. This.Engine.Rec_World.Ptr.Possibles.Last_Index
         loop
-            This.Possibles.Append (This.Engine.Rec_World.Possibles (Index));
+            This.Possibles.Append (This.Engine.Rec_World.Ptr.Possibles (Index));
         end loop;
-        This.Engine.Rec_Index := This.Engine.Rec_World.Possibles.Last_Index + 1;
+        This.Engine.Rec_Index := This.Engine.Rec_World.Ptr.Possibles.Last_Index + 1;
     end Roll_Recurse_Gen;
 
 
@@ -503,7 +496,7 @@ package body Kompsos is
         return My_Term : constant Term := T (Variable'(Ident => This.Next_Ident, Name => Name)) do
             This.Engine :=
                (Kind      => Fresh_Gen,
-                Frs_World => new Mu_World'Class'(This),
+                Frs_World => Hold (This),
                 Frs_Name  => Name);
             This.Next_Ident := This.Next_Ident + 1;
             This.Possibles := State_Vectors.Empty_Vector;
@@ -539,12 +532,12 @@ package body Kompsos is
             Left, Right : in Term'Class)
         return Mu_World is
     begin
-        return Result : constant Mu_World := (Ada.Finalization.Controlled with
-            Possibles  => State_Vectors.Empty_Vector,
+        return Result : constant Mu_World :=
+           (Possibles  => State_Vectors.Empty_Vector,
             Next_Ident => This.Next_Ident,
             Engine     =>
                (Kind      => Unify_Gen,
-                Uni_World => new Mu_World'(This),
+                Uni_World => Hold (This),
                 Uni_Term1 => Term (Left),
                 Uni_Term2 => Term (Right)));
     end Unify;
@@ -566,13 +559,13 @@ package body Kompsos is
            (Left, Right : in Mu_World)
         return Mu_World is
     begin
-        return Result : constant Mu_World := (Ada.Finalization.Controlled with
-            Possibles  => State_Vectors.Empty_Vector,
+        return Result : constant Mu_World :=
+           (Possibles  => State_Vectors.Empty_Vector,
             Next_Ident => ID_Number'Max (Left.Next_Ident, Right.Next_Ident),
             Engine     =>
                (Kind       => Disjunct_Gen,
-                Dis_World1 => new Mu_World'(Left),
-                Dis_World2 => new Mu_World'(Right)));
+                Dis_World1 => Hold (Left),
+                Dis_World2 => Hold (Right)));
     end Disjunct;
 
 
@@ -589,26 +582,24 @@ package body Kompsos is
         return Mu_World is
     begin
         if Inputs'Length = 0 then
-            return Failed : constant Mu_World := (Ada.Finalization.Controlled with
-                Possibles  => State_Vectors.Empty_Vector,
+            return Failed : constant Mu_World :=
+               (Possibles  => State_Vectors.Empty_Vector,
                 Next_Ident => 0,
                 Engine     => (Kind => No_Gen));
         elsif Inputs'Length = 1 then
             return Inputs (Inputs'First);
         else
-            return Result : Mu_World := (Ada.Finalization.Controlled with
-                Possibles  => State_Vectors.Empty_Vector,
+            return Result : Mu_World :=
+               (Possibles  => State_Vectors.Empty_Vector,
                 Next_Ident => 0,  --  dummy
                 Engine     =>
                    (Kind       => Disjunct_Gen,
-                    Dis_World1 =>
-                        new Mu_World'(Inputs (Inputs'First)),
-                    Dis_World2 =>
-                        new Mu_World'(Disjunct (Inputs (Inputs'First + 1 .. Inputs'Last)))))
+                    Dis_World1 => Hold (Inputs (Inputs'First)),
+                    Dis_World2 => Hold (Disjunct (Inputs (Inputs'First + 1 .. Inputs'Last)))))
             do
                 Result.Next_Ident := ID_Number'Max
-                   (Result.Engine.Dis_World1.Next_Ident,
-                    Result.Engine.Dis_World2.Next_Ident);
+                   (Result.Engine.Dis_World1.Ptr.Next_Ident,
+                    Result.Engine.Dis_World2.Ptr.Next_Ident);
             end return;
         end if;
     end Disjunct;
@@ -630,12 +621,12 @@ package body Kompsos is
            (This : in Mu_World)
         return Mu_World is
     begin
-        return Result : constant Mu_World := (Ada.Finalization.Controlled with
-            Possibles  => State_Vectors.Empty_Vector,
+        return Result : constant Mu_World :=
+           (Possibles  => State_Vectors.Empty_Vector,
             Next_Ident => This.Next_Ident,
             Engine     =>
                (Kind      => Recurse_Gen,
-                Rec_World => new Mu_World'(This),
+                Rec_World => Hold (This),
                 Rec_Index => 1));
     end Recurse;
 
@@ -657,8 +648,8 @@ package body Kompsos is
         return Mu_World is
     begin
         if Count = 0 then
-            return (Ada.Finalization.Controlled with
-                Possibles  => State_Vectors.Empty_Vector,
+            return
+               (Possibles  => State_Vectors.Empty_Vector,
                 Next_Ident => ID_Number'First,
                 Engine     => (Kind => No_Gen));
         end if;
diff --git a/src/kompsos.ads b/src/kompsos.ads
index d2b6fe5..f3f8470 100644
--- a/src/kompsos.ads
+++ b/src/kompsos.ads
@@ -233,6 +233,26 @@ private
 
     type World_Access is access Mu_World'Class;
 
+    type World_Holder is new Ada.Finalization.Controlled with record
+        Ptr : World_Access;
+    end record;
+
+    overriding procedure Initialize
+           (This : in out World_Holder);
+
+    overriding procedure Adjust
+           (This : in out World_Holder);
+
+    overriding procedure Finalize
+           (This : in out World_Holder);
+
+    function Hold
+           (This : in Mu_World'Class)
+        return World_Holder;
+
+    procedure Swap
+           (Left, Right : in out World_Holder);
+
     type Generator_Kind is
        (No_Gen,
         Fresh_Gen,
@@ -246,20 +266,20 @@ private
         when No_Gen =>
             null;
         when Fresh_Gen =>
-            Frs_World  : World_Access;
+            Frs_World  : World_Holder;
             Frs_Name   : SU.Unbounded_String;
         when Unify_Gen =>
-            Uni_World  : World_Access;
+            Uni_World  : World_Holder;
             Uni_Term1  : Term;
             Uni_Term2  : Term;
         when Buffer_Gen =>
-            Buff_World : World_Access;
+            Buff_World : World_Holder;
         when Disjunct_Gen =>
-            Dis_World1 : World_Access;
-            Dis_World2 : World_Access;
+            Dis_World1 : World_Holder;
+            Dis_World2 : World_Holder;
         when Recurse_Gen =>
-            Rec_World : World_Access;
-            Rec_Index : Positive;
+            Rec_World  : World_Holder;
+            Rec_Index  : Positive;
         end case;
     end record;
 
@@ -267,18 +287,12 @@ private
        (Index_Type   => Positive,
         Element_Type => State);
 
-    type Mu_World is new Ada.Finalization.Controlled with record
+    type Mu_World is tagged record
         Possibles  : State_Vectors.Vector;
         Next_Ident : ID_Number;
         Engine     : Generator;
     end record;
 
-    overriding procedure Adjust
-           (This : in out Mu_World);
-
-    overriding procedure Finalize
-           (This : in out Mu_World);
-
     function Has_State
            (This  : in out Mu_World;
             Index : in     Positive)
@@ -293,8 +307,8 @@ private
 
     use type State_Vectors.Vector;
 
-    Empty_Mu_World : constant Mu_World := (Ada.Finalization.Controlled with
-        Possibles  => State_Vectors.Empty_Vector & Empty_State,
+    Empty_Mu_World : constant Mu_World :=
+       (Possibles  => State_Vectors.Empty_Vector & Empty_State,
         Next_Ident => 0,
         Engine     => (Kind => No_Gen));