summaryrefslogtreecommitdiff
path: root/src/kompsos.ads
diff options
context:
space:
mode:
authorJedidiah Barber <contact@jedbarber.id.au>2025-11-15 16:06:40 +1300
committerJedidiah Barber <contact@jedbarber.id.au>2025-11-15 16:06:40 +1300
commit69514149fb1ddc17be744a883806e8bc3c8ebb7a (patch)
tree52ae7a59f4673145413e74b05fa80e9aafb6851b /src/kompsos.ads
parent72faae829a789664eedbda930cf815663c41c591 (diff)
Refactor of Terms that causes GNAT to STORAGE_ERROR
Diffstat (limited to 'src/kompsos.ads')
-rw-r--r--src/kompsos.ads62
1 files changed, 39 insertions, 23 deletions
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);