From 0e3cb04b840c3ecc61b9e3efc77af5ebea585d17 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Mon, 17 Nov 2025 14:56:34 +1300 Subject: Refactor of Conjunct Generators --- src/kompsos.adb | 125 ++++++++++++++++++++++++-------------------------------- 1 file changed, 53 insertions(+), 72 deletions(-) (limited to 'src/kompsos.adb') diff --git a/src/kompsos.adb b/src/kompsos.adb index f338e7e..2093406 100644 --- a/src/kompsos.adb +++ b/src/kompsos.adb @@ -256,6 +256,24 @@ package body Kompsos is -- Lazy World Generation -- + function Call_Lazy + (This : in World; + Data : in Lazy_Holders.Holder) + return World + is + Ref : constant Lazy_Holders.Constant_Reference_Type := Data.Constant_Reference; + begin + case Ref.Kind is + when Zero_Arg => + return Ref.ZFunc (This); + when One_Arg => + return Ref.OFunc (This, Ref.OInput); + when Many_Arg => + return Ref.MFunc (This, Term_Array_Holders.Constant_Reference (Ref.MInput)); + end case; + end Call_Lazy; + + function Has_State (This : in out World; Index : in Positive) @@ -329,62 +347,23 @@ package body Kompsos is end Roll_Disjunct_Gen; - procedure Roll_Conjunct_Zero_Gen - (This : in out World) - is - use type Ada.Containers.Count_Type; - begin - Ptr (This.Engine.ConZ_World).Rollover; - if Ptr (This.Engine.ConZ_World).Possibles.Length > 0 then - declare - Next : constant World := This.Engine.ConZ_Func (Ptr (This.Engine.ConZ_World).all); - begin - This := Next; - end; - elsif Ptr (This.Engine.ConZ_World).Engine.Kind = No_Gen then - This.Engine := (Kind => No_Gen); - end if; - end Roll_Conjunct_Zero_Gen; - - - procedure Roll_Conjunct_One_Gen - (This : in out World) - is - use type Ada.Containers.Count_Type; - begin - Ptr (This.Engine.ConO_World).Rollover; - if Ptr (This.Engine.ConO_World).Possibles.Length > 0 then - declare - Next : constant World := This.Engine.ConO_Func - (Ptr (This.Engine.ConO_World).all, - This.Engine.ConO_Input); - begin - This := Next; - end; - elsif Ptr (This.Engine.ConO_World).Engine.Kind = No_Gen then - This.Engine := (Kind => No_Gen); - end if; - end Roll_Conjunct_One_Gen; - - - procedure Roll_Conjunct_Many_Gen + procedure Roll_Conjunct_Gen (This : in out World) is use type Ada.Containers.Count_Type; begin - Ptr (This.Engine.ConM_World).Rollover; - if Ptr (This.Engine.ConM_World).Possibles.Length > 0 then + Ptr (This.Engine.Con_World).Rollover; + if Ptr (This.Engine.Con_World).Possibles.Length > 0 then declare - Next : constant World := This.Engine.ConM_Func - (Ptr (This.Engine.ConM_World).all, - This.Engine.ConM_Inputs.Constant_Reference); + Next : constant World := + Call_Lazy (Ptr (This.Engine.Con_World).all, This.Engine.Con_Data); begin This := Next; end; - elsif Ptr (This.Engine.ConM_World).Engine.Kind = No_Gen then + elsif Ptr (This.Engine.Con_World).Engine.Kind = No_Gen then This.Engine := (Kind => No_Gen); end if; - end Roll_Conjunct_Many_Gen; + end Roll_Conjunct_Gen; procedure Roll_Recurse_Gen @@ -414,15 +393,13 @@ package body Kompsos is (This : in out World) is begin case This.Engine.Kind is - when No_Gen => null; - when Fresh_Gen => This.Roll_Fresh_Gen; - when Unify_Gen => This.Roll_Unify_Gen; - when Buffer_Gen => This.Roll_Buffer_Gen; - when Disjunct_Gen => This.Roll_Disjunct_Gen; - when Conjunct_Zero_Gen => This.Roll_Conjunct_Zero_Gen; - when Conjunct_One_Gen => This.Roll_Conjunct_One_Gen; - when Conjunct_Many_Gen => This.Roll_Conjunct_Many_Gen; - when Recurse_Gen => This.Roll_Recurse_Gen; + when No_Gen => null; + when Fresh_Gen => This.Roll_Fresh_Gen; + when Unify_Gen => This.Roll_Unify_Gen; + when Buffer_Gen => This.Roll_Buffer_Gen; + when Disjunct_Gen => This.Roll_Disjunct_Gen; + when Conjunct_Gen => This.Roll_Conjunct_Gen; + when Recurse_Gen => This.Roll_Recurse_Gen; end case; end Rollover; @@ -607,21 +584,21 @@ package body Kompsos is function Conjunct (This : in World; - Func : in Conjunct_Zero_Func) + Func : in Junction_Zero_Func) return World is begin return Result : constant World := (Possibles => State_Vectors.Empty_Vector, Engine => - (Kind => Conjunct_Zero_Gen, - ConZ_World => Hold (This), - ConZ_Func => Func)); + (Kind => Conjunct_Gen, + Con_World => Hold (This), + Con_Data => Lazy_Holders.To_Holder ((Kind => Zero_Arg, ZFunc => Func)))); end Conjunct; procedure Conjunct (This : in out World; - Func : in Conjunct_Zero_Func) is + Func : in Junction_Zero_Func) is begin This := This.Conjunct (Func); end Conjunct; @@ -629,23 +606,25 @@ package body Kompsos is function Conjunct (This : in World; - Func : in Conjunct_One_Func; + Func : in Junction_One_Func; Input : in Term'Class) return World is begin return Result : constant World := (Possibles => State_Vectors.Empty_Vector, Engine => - (Kind => Conjunct_One_Gen, - ConO_World => Hold (This), - ConO_Func => Func, - ConO_Input => Term (Input))); + (Kind => Conjunct_Gen, + Con_World => Hold (This), + Con_Data => Lazy_Holders.To_Holder + ((Kind => One_Arg, + OFunc => Func, + OInput => Term (Input))))); end Conjunct; procedure Conjunct (This : in out World; - Func : in Conjunct_One_Func; + Func : in Junction_One_Func; Input : in Term'Class) is begin This := This.Conjunct (Func, Input); @@ -654,23 +633,25 @@ package body Kompsos is function Conjunct (This : in World; - Func : in Conjunct_Many_Func; + Func : in Junction_Many_Func; Inputs : in Term_Array) return World is begin return Result : constant World := (Possibles => State_Vectors.Empty_Vector, Engine => - (Kind => Conjunct_Many_Gen, - ConM_World => Hold (This), - ConM_Func => Func, - ConM_Inputs => Term_Array_Holders.To_Holder (Inputs))); + (Kind => Conjunct_Gen, + Con_World => Hold (This), + Con_Data => Lazy_Holders.To_Holder + ((Kind => Many_Arg, + MFunc => Func, + MInput => Term_Array_Holders.To_Holder (Inputs))))); end Conjunct; procedure Conjunct (This : in out World; - Func : in Conjunct_Many_Func; + Func : in Junction_Many_Func; Inputs : in Term_Array) is begin This := This.Conjunct (Func, Inputs); -- cgit