From 69514149fb1ddc17be744a883806e8bc3c8ebb7a Mon Sep 17 00:00:00 2001
From: Jedidiah Barber <contact@jedbarber.id.au>
Date: Sat, 15 Nov 2025 16:06:40 +1300
Subject: Refactor of Terms that causes GNAT to STORAGE_ERROR

---
 src/kompsos.ads | 62 ++++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 39 insertions(+), 23 deletions(-)

(limited to 'src/kompsos.ads')

diff --git a/src/kompsos.ads b/src/kompsos.ads
index 0463f6f..37533be 100644
--- a/src/kompsos.ads
+++ b/src/kompsos.ads
@@ -27,14 +27,15 @@ package Kompsos is
     --  Datatypes  --
     -----------------
 
+    type Variable is private;
+
+
+    type Term_Kind is (Null_Term, Atom_Term, Var_Term, Pair_Term);
+
     type Term is tagged private;
     type Term_Array is array (Positive range <>) of Term;
 
-    Null_Term : constant Term;
-
-    function "="
-           (Left, Right : in Term)
-        return Boolean;
+    Empty_Term : constant Term;
 
     function T
            (Item : in Element_Type)
@@ -48,7 +49,29 @@ package Kompsos is
            (Items : in Term_Array)
         return Term;
 
-    --  Might include subprograms to retrieve Term contents later?
+    function Kind
+           (This : in Term)
+        return Term_Kind;
+
+    function Atom
+           (This : in Term)
+        return Element_Type
+    with Pre => This.Kind = Atom_Term;
+
+    function Var
+           (This : in Term)
+        return Variable
+    with Pre => This.Kind = Var_Term;
+
+    function Left
+           (This : in Term)
+        return Term
+    with Pre => This.Kind = Pair_Term;
+
+    function Right
+           (This : in Term)
+        return Term
+    with Pre => This.Kind = Pair_Term;
 
 
     type World is tagged private;
@@ -392,11 +415,14 @@ private
 
 
 
-    type Term_Kind is (Atom_Term, Var_Term, Pair_Term);
+    type Term_Root is abstract tagged null record;
 
-    type Term_Component (Kind : Term_Kind) is record
-        Count : Long_Integer;
+    package Term_Holders is new Ada.Containers.Indefinite_Holders (Term_Root'Class);
+
+    type Term_Component (Kind : Term_Kind) is new Term_Root with record
         case Kind is
+        when Null_Term =>
+            null;
         when Atom_Term =>
             Value : Element_Type;
         when Var_Term =>
@@ -406,22 +432,12 @@ private
         end case;
     end record;
 
-    type Term_Component_Access is access Term_Component;
-
-    type Term is new Ada.Finalization.Controlled with record
-        Actual : Term_Component_Access;
+    type Term is tagged record
+        Actual : Term_Holders.Holder := Term_Holders.To_Holder (Term_Component'(Kind => Null_Term));
     end record;
 
-    overriding procedure Initialize
-           (This : in out Term);
-
-    overriding procedure Adjust
-           (This : in out Term);
-
-    overriding procedure Finalize
-           (This : in out Term);
-
-    Null_Term : constant Term := (Ada.Finalization.Controlled with Actual => null);
+    Empty_Term : constant Term :=
+        (Actual => Term_Holders.To_Holder (Term_Component'(Kind => Null_Term)));
 
     package Term_Array_Holders is new Ada.Containers.Indefinite_Holders (Term_Array);
 
-- 
cgit