From 3356c1956735504f2197b12f1b423aec50a6bd6b Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Tue, 11 Nov 2025 18:07:14 +1300 Subject: Finegrained better handled laziness, forced evaluation, disjunct for world arrays --- src/kompsos.ads | 59 ++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 40 insertions(+), 19 deletions(-) (limited to 'src/kompsos.ads') diff --git a/src/kompsos.ads b/src/kompsos.ads index a2e210e..d229eb3 100644 --- a/src/kompsos.ads +++ b/src/kompsos.ads @@ -26,8 +26,6 @@ package Kompsos is type Variable_Array is array (Positive range <>) of Variable; - - type Term is tagged private; type Term_Array is array (Positive range <>) of Term; @@ -58,9 +56,8 @@ package Kompsos is -- Might include subprograms to retrieve Term contents later? - - type World is tagged private; + type World_Array is array (Positive range <>) of World; Empty_World : constant World; @@ -135,6 +132,14 @@ package Kompsos is (This : in out World; Right : in World); + function Disjunct + (Inputs : in World_Array) + return World; + + procedure Disjunct + (This : in out World; + Inputs : in World_Array); + @@ -157,6 +162,13 @@ package Kompsos is (This : in out World; Count : in Natural); + procedure Force + (This : in out World; + Count : in Positive); + + procedure Force_All + (This : in out World); + private @@ -245,29 +257,38 @@ private type World_Access is access World; - type Generator_Kind is (No_Gen, Fresh_Gen, Unify_Gen, Disjunct_Gen, Recurse_Gen); + type Generator_Kind is + (No_Gen, + Fresh_Gen, + Unify_Gen, + Disjunct1_Gen, + Disjunct2_Gen, + Recurse_Gen); type Generator (Kind : Generator_Kind := No_Gen) is record case Kind is when No_Gen => null; when Fresh_Gen => - FrG_World : World_Access; - FrG_Index : Positive; - FrG_Name : SU.Unbounded_String; + FrG_World : World_Access; + FrG_Index : Positive; + FrG_Name : SU.Unbounded_String; when Unify_Gen => - UniG_World : World_Access; - UniG_Index : Positive; - UniG_Term1 : Term; - UniG_Term2 : Term; - when Disjunct_Gen => - DisG_World1 : World_Access; - DisG_Index1 : Positive; - DisG_World2 : World_Access; - DisG_Index2 : Positive; + UniG_World : World_Access; + UniG_Index : Positive; + UniG_Term1 : Term; + UniG_Term2 : Term; + when Disjunct1_Gen => + Dis1G_World : World_Access; + Dis1G_Index : Positive; + when Disjunct2_Gen => + Dis2G_World1 : World_Access; + Dis2G_Index1 : Positive; + Dis2G_World2 : World_Access; + Dis2G_Index2 : Positive; when Recurse_Gen => - RecG_World : World_Access; - RecG_Index : Positive; + RecG_World : World_Access; + RecG_Index : Positive; end case; end record; -- cgit