diff options
| -rw-r--r-- | src/kompsos.adb | 125 | ||||
| -rw-r--r-- | src/kompsos.ads | 75 |
2 files changed, 94 insertions, 106 deletions
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); diff --git a/src/kompsos.ads b/src/kompsos.ads index ed5c664..7b79d60 100644 --- a/src/kompsos.ads +++ b/src/kompsos.ads @@ -96,16 +96,16 @@ package Kompsos is -- Junction Functions -- - type Conjunct_Zero_Func is access function + type Junction_Zero_Func is access function (This : in World) return World; - type Conjunct_One_Func is access function + type Junction_One_Func is access function (This : in World; Input : in Term'Class) return World; - type Conjunct_Many_Func is access function + type Junction_Many_Func is access function (This : in World; Inputs : in Term_Array) return World; @@ -199,33 +199,33 @@ package Kompsos is function Conjunct (This : in World; - Func : in Conjunct_Zero_Func) + Func : in Junction_Zero_Func) return World; procedure Conjunct (This : in out World; - Func : in Conjunct_Zero_Func); + Func : in Junction_Zero_Func); function Conjunct (This : in World; - Func : in Conjunct_One_Func; + Func : in Junction_One_Func; Input : in Term'Class) return World; procedure Conjunct (This : in out World; - Func : in Conjunct_One_Func; + Func : in Junction_One_Func; Input : in Term'Class); function Conjunct (This : in World; - Func : in Conjunct_Many_Func; + Func : in Junction_Many_Func; Inputs : in Term_Array) return World; procedure Conjunct (This : in out World; - Func : in Conjunct_Many_Func; + Func : in Junction_Many_Func; Inputs : in Term_Array); @@ -534,15 +534,30 @@ private (Left, Right : in out World_Holders.Holder) with Inline; + type Lazy_Kind is (Zero_Arg, One_Arg, Many_Arg); + + type Lazy_Data (Kind : Lazy_Kind) is record + case Kind is + when Zero_Arg => + ZFunc : Junction_Zero_Func; + when One_Arg => + OFunc : Junction_One_Func; + OInput : Term; + when Many_Arg => + MFunc : Junction_Many_Func; + MInput : Term_Array_Holders.Holder; + end case; + end record; + + package Lazy_Holders is new Ada.Containers.Indefinite_Holders (Lazy_Data); + type Generator_Kind is (No_Gen, Fresh_Gen, Unify_Gen, Buffer_Gen, Disjunct_Gen, - Conjunct_Zero_Gen, - Conjunct_One_Gen, - Conjunct_Many_Gen, + Conjunct_Gen, Recurse_Gen); type Generator (Kind : Generator_Kind := No_Gen) is record @@ -550,32 +565,24 @@ private when No_Gen => null; when Fresh_Gen => - Frs_Ident : Generator_ID_Number; - Frs_World : World_Holders.Holder; - Frs_Name : Nametag; + Frs_Ident : Generator_ID_Number; + Frs_World : World_Holders.Holder; + Frs_Name : Nametag; when Unify_Gen => - Uni_World : World_Holders.Holder; - Uni_Term1 : Term; - Uni_Term2 : Term; + Uni_World : World_Holders.Holder; + Uni_Term1 : Term; + Uni_Term2 : Term; when Buffer_Gen => - Buff_World : World_Holders.Holder; + Buff_World : World_Holders.Holder; when Disjunct_Gen => - Dis_World1 : World_Holders.Holder; - Dis_World2 : World_Holders.Holder; - when Conjunct_Zero_Gen => - ConZ_World : World_Holders.Holder; - ConZ_Func : Conjunct_Zero_Func; - when Conjunct_One_Gen => - ConO_World : World_Holders.Holder; - ConO_Func : Conjunct_One_Func; - ConO_Input : Term; - when Conjunct_Many_Gen => - ConM_World : World_Holders.Holder; - ConM_Func : Conjunct_Many_Func; - ConM_Inputs : Term_Array_Holders.Holder; + Dis_World1 : World_Holders.Holder; + Dis_World2 : World_Holders.Holder; + when Conjunct_Gen => + Con_World : World_Holders.Holder; + Con_Data : Lazy_Holders.Holder; when Recurse_Gen => - Rec_World : World_Holders.Holder; - Rec_Index : Positive; + Rec_World : World_Holders.Holder; + Rec_Index : Positive; end case; end record; |