Worlds now use Indefinite_Holders for holding themselves

2 files changed, 90 insertions, 118 deletions

diff --git a/src/kompsos.adb b/src/kompsos.adb
index 22f0eb9..9d45f66 100644
--- a/src/kompsos.adb
+++ b/src/kompsos.adb
@@ -6,64 +6,9 @@
 --  See license.txt for further details
 
 
-with
-
-    Ada.Unchecked_Deallocation;
-
-
 package body Kompsos is
 
 
-    -------------------------
-    --  Memory Management  --
-    -------------------------
-
-    --  World_Holders  --
-
-    procedure Free is new Ada.Unchecked_Deallocation (World'Class, World_Access);
-
-
-    procedure Initialize
-           (This : in out World_Holder) is
-    begin
-        This.Ptr := null;
-    end Initialize;
-
-
-    procedure Adjust
-           (This : in out World_Holder) is
-    begin
-        This.Ptr := new World'Class'(This.Ptr.all);
-    end Adjust;
-
-
-    procedure Finalize
-           (This : in out World_Holder) is
-    begin
-        Free (This.Ptr);
-    end Finalize;
-
-
-    function Hold
-           (This : in World'Class)
-        return World_Holder is
-    begin
-        return (Ada.Finalization.Controlled with Ptr => new 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;
-
-
-
-
     -----------------
     --  Datatypes  --
     -----------------
@@ -154,6 +99,36 @@ package body Kompsos is
 
 
 
+    --  Worlds  --
+
+    function Hold
+           (This : in World)
+        return World_Holders.Holder is
+    begin
+        return World_Holders.To_Holder (World_Root'Class (This));
+    end Hold;
+
+
+    function Ptr
+           (This : in out World_Holders.Holder)
+        return World_Access is
+    begin
+        return World (This.Reference.Element.all)'Unchecked_Access;
+    end Ptr;
+
+
+    procedure Swap
+           (Left, Right : in out World_Holders.Holder)
+    is
+        Temp : World_Holders.Holder;
+    begin
+        Temp.Move (Left);
+        Left.Move (Right);
+        Right.Move (Temp);
+    end Swap;
+
+
+
 
     ------------------------
     --  Internal Helpers  --
@@ -308,15 +283,15 @@ package body Kompsos is
     procedure Roll_Fresh_Gen
            (This : in out World) is
     begin
-        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);
+        Ptr (This.Engine.Frs_World).Rollover;
+        for Potential of Ptr (This.Engine.Frs_World).Possibles loop
+            Potential.LVars.Insert (Ptr (This.Engine.Frs_World).Next_Ident, This.Engine.Frs_Name);
             This.Possibles.Append (Potential);
         end loop;
-        if This.Engine.Frs_World.Ptr.Engine.Kind = No_Gen then
+        if Ptr (This.Engine.Frs_World).Engine.Kind = No_Gen then
             This.Engine := (Kind => No_Gen);
         else
-            This.Engine.Frs_World.Ptr.Possibles.Clear;
+            Ptr (This.Engine.Frs_World).Possibles.Clear;
         end if;
     end Roll_Fresh_Gen;
 
@@ -326,16 +301,16 @@ package body Kompsos is
     is
         Extended : State;
     begin
-        This.Engine.Uni_World.Ptr.Rollover;
-        for Potential of This.Engine.Uni_World.Ptr.Possibles loop
+        Ptr (This.Engine.Uni_World).Rollover;
+        for Potential of Ptr (This.Engine.Uni_World).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.Ptr.Engine.Kind = No_Gen then
+        if Ptr (This.Engine.Uni_World).Engine.Kind = No_Gen then
             This.Engine := (Kind => No_Gen);
         else
-            This.Engine.Uni_World.Ptr.Possibles.Clear;
+            Ptr (This.Engine.Uni_World).Possibles.Clear;
         end if;
     end Roll_Unify_Gen;
 
@@ -343,12 +318,12 @@ package body Kompsos is
     procedure Roll_Buffer_Gen
            (This : in out World) is
     begin
-        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
+        Ptr (This.Engine.Buff_World).Rollover;
+        This.Possibles.Append (Ptr (This.Engine.Buff_World).Possibles);
+        if Ptr (This.Engine.Buff_World).Engine.Kind = No_Gen then
             This.Engine := (Kind => No_Gen);
         else
-            This.Engine.Buff_World.Ptr.Possibles.Clear;
+            Ptr (This.Engine.Buff_World).Possibles.Clear;
         end if;
     end Roll_Buffer_Gen;
 
@@ -356,12 +331,12 @@ package body Kompsos is
     procedure Roll_Disjunct_Gen
            (This : in out World) is
     begin
-        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
+        Ptr (This.Engine.Dis_World1).Rollover;
+        This.Possibles.Append (Ptr (This.Engine.Dis_World1).Possibles);
+        if Ptr (This.Engine.Dis_World1).Engine.Kind = No_Gen then
             This.Engine := (Kind => Buffer_Gen, Buff_World => This.Engine.Dis_World2);
         else
-            This.Engine.Dis_World1.Ptr.Possibles.Clear;
+            Ptr (This.Engine.Dis_World1).Possibles.Clear;
             Swap (This.Engine.Dis_World1, This.Engine.Dis_World2);
         end if;
     end Roll_Disjunct_Gen;
@@ -372,15 +347,14 @@ package body Kompsos is
     is
         use type Ada.Containers.Count_Type;
     begin
-        This.Engine.ConZ_World.Ptr.Rollover;
-        if This.Engine.ConZ_World.Ptr.Possibles.Length > 0 then
+        Ptr (This.Engine.ConZ_World).Rollover;
+        if Ptr (This.Engine.ConZ_World).Possibles.Length > 0 then
             declare
-                Next : constant World := This.Engine.ConZ_Func
-                   (World (This.Engine.ConZ_World.Ptr.all));
+                Next : constant World := This.Engine.ConZ_Func (Ptr (This.Engine.ConZ_World).all);
             begin
                 This := Next;
             end;
-        elsif This.Engine.ConZ_World.Ptr.Engine.Kind = No_Gen then
+        elsif Ptr (This.Engine.ConZ_World).Engine.Kind = No_Gen then
             This.Engine := (Kind => No_Gen);
         end if;
     end Roll_Conjunct_Zero_Gen;
@@ -391,16 +365,16 @@ package body Kompsos is
     is
         use type Ada.Containers.Count_Type;
     begin
-        This.Engine.ConO_World.Ptr.Rollover;
-        if This.Engine.ConO_World.Ptr.Possibles.Length > 0 then
+        Ptr (This.Engine.ConO_World).Rollover;
+        if Ptr (This.Engine.ConO_World).Possibles.Length > 0 then
             declare
                 Next : constant World := This.Engine.ConO_Func
-                   (World (This.Engine.ConO_World.Ptr.all),
+                   (Ptr (This.Engine.ConO_World).all,
                     This.Engine.ConO_Input);
             begin
                 This := Next;
             end;
-        elsif This.Engine.ConO_World.Ptr.Engine.Kind = No_Gen then
+        elsif Ptr (This.Engine.ConO_World).Engine.Kind = No_Gen then
             This.Engine := (Kind => No_Gen);
         end if;
     end Roll_Conjunct_One_Gen;
@@ -411,16 +385,16 @@ package body Kompsos is
     is
         use type Ada.Containers.Count_Type;
     begin
-        This.Engine.ConM_World.Ptr.Rollover;
-        if This.Engine.ConM_World.Ptr.Possibles.Length > 0 then
+        Ptr (This.Engine.ConM_World).Rollover;
+        if Ptr (This.Engine.ConM_World).Possibles.Length > 0 then
             declare
                 Next : constant World := This.Engine.ConM_Func
-                   (World (This.Engine.ConM_World.Ptr.all),
+                   (Ptr (This.Engine.ConM_World).all,
                     This.Engine.ConM_Inputs.Constant_Reference);
             begin
                 This := Next;
             end;
-        elsif This.Engine.ConM_World.Ptr.Engine.Kind = No_Gen then
+        elsif Ptr (This.Engine.ConM_World).Engine.Kind = No_Gen then
             This.Engine := (Kind => No_Gen);
         end if;
     end Roll_Conjunct_Many_Gen;
@@ -429,9 +403,9 @@ package body Kompsos is
     procedure Roll_Recurse_Gen
            (This : in out World) is
     begin
-        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
+        Ptr (This.Engine.Rec_World).Rollover;
+        if Ptr (This.Engine.Rec_World).Possibles.Last_Index < This.Engine.Rec_Index then
+            if Ptr (This.Engine.Rec_World).Engine.Kind = No_Gen then
                 if This.Engine.Rec_Index = 1 then
                     This.Engine := (Kind => No_Gen);
                 else
@@ -441,11 +415,11 @@ package body Kompsos is
             return;
         end if;
         for Index in Integer range
-            This.Engine.Rec_Index .. This.Engine.Rec_World.Ptr.Possibles.Last_Index
+            This.Engine.Rec_Index .. Ptr (This.Engine.Rec_World).Possibles.Last_Index
         loop
-            This.Possibles.Append (This.Engine.Rec_World.Ptr.Possibles (Index));
+            This.Possibles.Append (Ptr (This.Engine.Rec_World).Possibles (Index));
         end loop;
-        This.Engine.Rec_Index := This.Engine.Rec_World.Ptr.Possibles.Last_Index + 1;
+        This.Engine.Rec_Index := Ptr (This.Engine.Rec_World).Possibles.Last_Index + 1;
     end Roll_Recurse_Gen;
 
 
@@ -609,8 +583,8 @@ package body Kompsos is
                     Dis_World2 => Hold (Disjunct (Inputs (Inputs'First + 1 .. Inputs'Last)))))
             do
                 Result.Next_Ident := ID_Number'Max
-                   (Result.Engine.Dis_World1.Ptr.Next_Ident,
-                    Result.Engine.Dis_World2.Ptr.Next_Ident);
+                   (Ptr (Result.Engine.Dis_World1).Next_Ident,
+                    Ptr (Result.Engine.Dis_World2).Next_Ident);
             end return;
         end if;
     end Disjunct;
diff --git a/src/kompsos.ads b/src/kompsos.ads
index 5a6af5f..cf4ba31 100644
--- a/src/kompsos.ads
+++ b/src/kompsos.ads
@@ -465,27 +465,25 @@ private
 
 
 
-    type World_Access is access World'Class;
+    type World_Root is abstract tagged null record;
 
-    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);
+    package World_Holders is new Ada.Containers.Indefinite_Holders (World_Root'Class);
 
-    overriding procedure Finalize
-           (This : in out World_Holder);
+    type World_Access is access all World;
 
     function Hold
-           (This : in World'Class)
-        return World_Holder;
+           (This : in World)
+        return World_Holders.Holder
+    with Inline;
+
+    function Ptr
+           (This : in out World_Holders.Holder)
+        return World_Access
+    with Inline;
 
     procedure Swap
-           (Left, Right : in out World_Holder);
+           (Left, Right : in out World_Holders.Holder)
+    with Inline;
 
     type Generator_Kind is
        (No_Gen,
@@ -503,30 +501,30 @@ private
         when No_Gen =>
             null;
         when Fresh_Gen =>
-            Frs_World   : World_Holder;
+            Frs_World   : World_Holders.Holder;
             Frs_Name    : SU.Unbounded_String;
         when Unify_Gen =>
-            Uni_World   : World_Holder;
+            Uni_World   : World_Holders.Holder;
             Uni_Term1   : Term;
             Uni_Term2   : Term;
         when Buffer_Gen =>
-            Buff_World  : World_Holder;
+            Buff_World  : World_Holders.Holder;
         when Disjunct_Gen =>
-            Dis_World1  : World_Holder;
-            Dis_World2  : World_Holder;
+            Dis_World1  : World_Holders.Holder;
+            Dis_World2  : World_Holders.Holder;
         when Conjunct_Zero_Gen =>
-            ConZ_World  : World_Holder;
+            ConZ_World  : World_Holders.Holder;
             ConZ_Func   : Conjunct_Zero_Func;
         when Conjunct_One_Gen =>
-            ConO_World  : World_Holder;
+            ConO_World  : World_Holders.Holder;
             ConO_Func   : Conjunct_One_Func;
             ConO_Input  : Term;
         when Conjunct_Many_Gen =>
-            ConM_World  : World_Holder;
+            ConM_World  : World_Holders.Holder;
             ConM_Func   : Conjunct_Many_Func;
             ConM_Inputs : Term_Array_Holders.Holder;
         when Recurse_Gen =>
-            Rec_World   : World_Holder;
+            Rec_World   : World_Holders.Holder;
             Rec_Index   : Positive;
         end case;
     end record;
@@ -535,7 +533,7 @@ private
        (Index_Type   => Positive,
         Element_Type => State);
 
-    type World is tagged record
+    type World is new World_Root with record
         Possibles  : State_Vectors.Vector;
         Next_Ident : ID_Number;
         Engine     : Generator;