Switches out Holders for Controlled component in Term

2 files changed, 82 insertions, 25 deletions

diff --git a/src/kompsos.adb b/src/kompsos.adb
index 0ac59ee..d531f25 100644
--- a/src/kompsos.adb
+++ b/src/kompsos.adb
@@ -6,9 +6,53 @@
 --  See license.txt for further details
 
 
+with
+
+    Ada.Unchecked_Deallocation;
+
+
 package body Kompsos is
 
 
+    -------------------------
+    --  Memory Management  --
+    -------------------------
+
+    --  Terms  --
+
+    procedure Free is new Ada.Unchecked_Deallocation (Term_Component, Term_Component_Access);
+
+
+    procedure Initialize
+           (This : in out Term) is
+    begin
+        This.Actual := null;
+    end Initialize;
+
+
+    procedure Adjust
+           (This : in out Term) is
+    begin
+        if This.Kind /= Null_Term then
+            This.Actual.Counter := This.Actual.Counter + 1;
+        end if;
+    end Adjust;
+
+
+    procedure Finalize
+           (This : in out Term) is
+    begin
+        if This.Kind /= Null_Term then
+            This.Actual.Counter := This.Actual.Counter - 1;
+            if This.Actual.Counter = 0 then
+                Free (This.Actual);
+            end if;
+        end if;
+    end Finalize;
+
+
+
+
     -----------------
     --  Datatypes  --
     -----------------
@@ -19,7 +63,7 @@ package body Kompsos is
            (This : in Term)
         return Term_Kind is
     begin
-        return Term_Component (This.Actual.Constant_Reference.Element.all).Kind;
+        return (if This.Actual = null then Null_Term else This.Actual.Kind);
     end Kind;
 
 
@@ -27,9 +71,10 @@ package body Kompsos is
            (Item : in Element_Type)
         return Term is
     begin
-        return (Actual => Term_Holders.To_Holder (Term_Component'(
-            Kind  => Atom_Term,
-            Value => Item)));
+        return (Ada.Finalization.Controlled with Actual => new Term_Component'(
+            Kind    => Atom_Term,
+            Counter => 1,
+            Value   => Item));
     end T;
 
 
@@ -37,9 +82,10 @@ package body Kompsos is
            (Item : in Variable)
         return Term'Class is
     begin
-        return Term'(Actual => Term_Holders.To_Holder (Term_Component'(
-            Kind  => Var_Term,
-            Refer => Item)));
+        return Term'(Ada.Finalization.Controlled with Actual => new Term_Component'(
+            Kind    => Var_Term,
+            Counter => 1,
+            Refer   => Item));
     end T;
 
 
@@ -47,10 +93,11 @@ package body Kompsos is
            (Item1, Item2 : in Term'Class)
         return Term is
     begin
-        return (Actual => Term_Holders.To_Holder (Term_Component'(
-            Kind  => Pair_Term,
-            Left  => Term (Item1),
-            Right => Term (Item2))));
+        return (Ada.Finalization.Controlled with Actual => new Term_Component'(
+            Kind    => Pair_Term,
+            Counter => 1,
+            Left    => Term (Item1),
+            Right   => Term (Item2)));
     end T;
 
 
@@ -70,7 +117,7 @@ package body Kompsos is
            (This : in Term)
         return Element_Type is
     begin
-        return Term_Component (This.Actual.Constant_Reference.Element.all).Value;
+        return This.Actual.Value;
     end Atom;
 
 
@@ -78,7 +125,7 @@ package body Kompsos is
            (This : in Term'Class)
         return Variable is
     begin
-        return Term_Component (This.Actual.Constant_Reference.Element.all).Refer;
+        return This.Actual.Refer;
     end Var;
 
 
@@ -94,7 +141,7 @@ package body Kompsos is
            (This : in Term)
         return Term is
     begin
-        return Term_Component (This.Actual.Constant_Reference.Element.all).Left;
+        return This.Actual.Left;
     end Left;
 
 
@@ -102,7 +149,7 @@ package body Kompsos is
            (This : in Term)
         return Term is
     begin
-        return Term_Component (This.Actual.Constant_Reference.Element.all).Right;
+        return This.Actual.Right;
     end Right;
 
 
diff --git a/src/kompsos.ads b/src/kompsos.ads
index 0f2c0e6..0483fa1 100644
--- a/src/kompsos.ads
+++ b/src/kompsos.ads
@@ -14,7 +14,8 @@ private with
 
     Ada.Containers.Indefinite_Holders,
     Ada.Containers.Ordered_Maps,
-    Ada.Containers.Vectors;
+    Ada.Containers.Vectors,
+    Ada.Finalization;
 
 
 generic
@@ -485,14 +486,15 @@ private
 
 
 
-    type Term_Root is abstract tagged null record;
+    type Term_Component;
 
-    package Term_Holders is new Ada.Containers.Indefinite_Holders (Term_Root'Class);
+    type Term_Component_Access is access Term_Component;
 
-    type Term_Component (Kind : Term_Kind) is new Term_Root with record
+    subtype Non_Null_Term_Kind is Term_Kind range Atom_Term .. Pair_Term;
+
+    type Term_Component (Kind : Non_Null_Term_Kind) is limited record
+        Counter : Natural;
         case Kind is
-        when Null_Term =>
-            null;
         when Atom_Term =>
             Value : Element_Type;
         when Var_Term =>
@@ -502,10 +504,19 @@ private
         end case;
     end record;
 
-    type Term is tagged record
-        Actual : Term_Holders.Holder;
+    type Term is new Ada.Finalization.Controlled with record
+        Actual : Term_Component_Access := null;
     end record;
 
+    overriding procedure Initialize
+           (This : in out Term);
+
+    overriding procedure Adjust
+           (This : in out Term);
+
+    overriding procedure Finalize
+           (This : in out Term);
+
     function T
            (Item : in Variable)
         return Term'Class;
@@ -515,8 +526,7 @@ private
         return Variable
     with Pre => This.Kind = Var_Term;
 
-    Empty_Term : constant Term :=
-        (Actual => Term_Holders.To_Holder (Term_Component'(Kind => Null_Term)));
+    Empty_Term : constant Term := (Ada.Finalization.Controlled with Actual => null);
 
     package Term_Array_Holders is new Ada.Containers.Indefinite_Holders (Term_Array);