diff options
| author | Jedidiah Barber <contact@jedbarber.id.au> | 2025-11-15 16:06:40 +1300 |
|---|---|---|
| committer | Jedidiah Barber <contact@jedbarber.id.au> | 2025-11-15 16:06:40 +1300 |
| commit | 69514149fb1ddc17be744a883806e8bc3c8ebb7a (patch) | |
| tree | 52ae7a59f4673145413e74b05fa80e9aafb6851b /src/kompsos.ads | |
| parent | 72faae829a789664eedbda930cf815663c41c591 (diff) | |
Refactor of Terms that causes GNAT to STORAGE_ERROR
Diffstat (limited to 'src/kompsos.ads')
| -rw-r--r-- | src/kompsos.ads | 62 |
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); |
