diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/kompsos.adb | 160 | ||||
| -rw-r--r-- | src/kompsos.ads | 48 |
2 files changed, 90 insertions, 118 deletions
diff --git a/src/kompsos.adb b/src/kompsos.adb index 22f0eb9..9d45f66 100644 --- a/src/kompsos.adb +++ b/src/kompsos.adb @@ -6,64 +6,9 @@ -- See license.txt for further details -with - - Ada.Unchecked_Deallocation; - - package body Kompsos is - ------------------------- - -- Memory Management -- - ------------------------- - - -- World_Holders -- - - procedure Free is new Ada.Unchecked_Deallocation (World'Class, World_Access); - - - procedure Initialize - (This : in out World_Holder) is - begin - This.Ptr := null; - end Initialize; - - - procedure Adjust - (This : in out World_Holder) is - begin - This.Ptr := new World'Class'(This.Ptr.all); - end Adjust; - - - procedure Finalize - (This : in out World_Holder) is - begin - Free (This.Ptr); - end Finalize; - - - function Hold - (This : in World'Class) - return World_Holder is - begin - return (Ada.Finalization.Controlled with Ptr => new World'Class'(This)); - end Hold; - - - procedure Swap - (Left, Right : in out World_Holder) - is - Temp_Ptr : World_Access := Left.Ptr; - begin - Left.Ptr := Right.Ptr; - Right.Ptr := Temp_Ptr; - end Swap; - - - - ----------------- -- Datatypes -- ----------------- @@ -154,6 +99,36 @@ package body Kompsos is + -- Worlds -- + + function Hold + (This : in World) + return World_Holders.Holder is + begin + return World_Holders.To_Holder (World_Root'Class (This)); + end Hold; + + + function Ptr + (This : in out World_Holders.Holder) + return World_Access is + begin + return World (This.Reference.Element.all)'Unchecked_Access; + end Ptr; + + + procedure Swap + (Left, Right : in out World_Holders.Holder) + is + Temp : World_Holders.Holder; + begin + Temp.Move (Left); + Left.Move (Right); + Right.Move (Temp); + end Swap; + + + ------------------------ -- Internal Helpers -- @@ -308,15 +283,15 @@ package body Kompsos is procedure Roll_Fresh_Gen (This : in out World) is begin - This.Engine.Frs_World.Ptr.Rollover; - for Potential of This.Engine.Frs_World.Ptr.Possibles loop - Potential.LVars.Insert (This.Engine.Frs_World.Ptr.Next_Ident, This.Engine.Frs_Name); + Ptr (This.Engine.Frs_World).Rollover; + for Potential of Ptr (This.Engine.Frs_World).Possibles loop + Potential.LVars.Insert (Ptr (This.Engine.Frs_World).Next_Ident, This.Engine.Frs_Name); This.Possibles.Append (Potential); end loop; - if This.Engine.Frs_World.Ptr.Engine.Kind = No_Gen then + if Ptr (This.Engine.Frs_World).Engine.Kind = No_Gen then This.Engine := (Kind => No_Gen); else - This.Engine.Frs_World.Ptr.Possibles.Clear; + Ptr (This.Engine.Frs_World).Possibles.Clear; end if; end Roll_Fresh_Gen; @@ -326,16 +301,16 @@ package body Kompsos is is Extended : State; begin - This.Engine.Uni_World.Ptr.Rollover; - for Potential of This.Engine.Uni_World.Ptr.Possibles loop + Ptr (This.Engine.Uni_World).Rollover; + for Potential of Ptr (This.Engine.Uni_World).Possibles loop if Do_Unify (Potential, This.Engine.Uni_Term1, This.Engine.Uni_Term2, Extended) then This.Possibles.Append (Extended); end if; end loop; - if This.Engine.Uni_World.Ptr.Engine.Kind = No_Gen then + if Ptr (This.Engine.Uni_World).Engine.Kind = No_Gen then This.Engine := (Kind => No_Gen); else - This.Engine.Uni_World.Ptr.Possibles.Clear; + Ptr (This.Engine.Uni_World).Possibles.Clear; end if; end Roll_Unify_Gen; @@ -343,12 +318,12 @@ package body Kompsos is procedure Roll_Buffer_Gen (This : in out World) is begin - This.Engine.Buff_World.Ptr.Rollover; - This.Possibles.Append (This.Engine.Buff_World.Ptr.Possibles); - if This.Engine.Buff_World.Ptr.Engine.Kind = No_Gen then + Ptr (This.Engine.Buff_World).Rollover; + This.Possibles.Append (Ptr (This.Engine.Buff_World).Possibles); + if Ptr (This.Engine.Buff_World).Engine.Kind = No_Gen then This.Engine := (Kind => No_Gen); else - This.Engine.Buff_World.Ptr.Possibles.Clear; + Ptr (This.Engine.Buff_World).Possibles.Clear; end if; end Roll_Buffer_Gen; @@ -356,12 +331,12 @@ package body Kompsos is procedure Roll_Disjunct_Gen (This : in out World) is begin - This.Engine.Dis_World1.Ptr.Rollover; - This.Possibles.Append (This.Engine.Dis_World1.Ptr.Possibles); - if This.Engine.Dis_World1.Ptr.Engine.Kind = No_Gen then + Ptr (This.Engine.Dis_World1).Rollover; + This.Possibles.Append (Ptr (This.Engine.Dis_World1).Possibles); + if Ptr (This.Engine.Dis_World1).Engine.Kind = No_Gen then This.Engine := (Kind => Buffer_Gen, Buff_World => This.Engine.Dis_World2); else - This.Engine.Dis_World1.Ptr.Possibles.Clear; + Ptr (This.Engine.Dis_World1).Possibles.Clear; Swap (This.Engine.Dis_World1, This.Engine.Dis_World2); end if; end Roll_Disjunct_Gen; @@ -372,15 +347,14 @@ package body Kompsos is is use type Ada.Containers.Count_Type; begin - This.Engine.ConZ_World.Ptr.Rollover; - if This.Engine.ConZ_World.Ptr.Possibles.Length > 0 then + Ptr (This.Engine.ConZ_World).Rollover; + if Ptr (This.Engine.ConZ_World).Possibles.Length > 0 then declare - Next : constant World := This.Engine.ConZ_Func - (World (This.Engine.ConZ_World.Ptr.all)); + Next : constant World := This.Engine.ConZ_Func (Ptr (This.Engine.ConZ_World).all); begin This := Next; end; - elsif This.Engine.ConZ_World.Ptr.Engine.Kind = No_Gen then + elsif Ptr (This.Engine.ConZ_World).Engine.Kind = No_Gen then This.Engine := (Kind => No_Gen); end if; end Roll_Conjunct_Zero_Gen; @@ -391,16 +365,16 @@ package body Kompsos is is use type Ada.Containers.Count_Type; begin - This.Engine.ConO_World.Ptr.Rollover; - if This.Engine.ConO_World.Ptr.Possibles.Length > 0 then + Ptr (This.Engine.ConO_World).Rollover; + if Ptr (This.Engine.ConO_World).Possibles.Length > 0 then declare Next : constant World := This.Engine.ConO_Func - (World (This.Engine.ConO_World.Ptr.all), + (Ptr (This.Engine.ConO_World).all, This.Engine.ConO_Input); begin This := Next; end; - elsif This.Engine.ConO_World.Ptr.Engine.Kind = No_Gen then + elsif Ptr (This.Engine.ConO_World).Engine.Kind = No_Gen then This.Engine := (Kind => No_Gen); end if; end Roll_Conjunct_One_Gen; @@ -411,16 +385,16 @@ package body Kompsos is is use type Ada.Containers.Count_Type; begin - This.Engine.ConM_World.Ptr.Rollover; - if This.Engine.ConM_World.Ptr.Possibles.Length > 0 then + Ptr (This.Engine.ConM_World).Rollover; + if Ptr (This.Engine.ConM_World).Possibles.Length > 0 then declare Next : constant World := This.Engine.ConM_Func - (World (This.Engine.ConM_World.Ptr.all), + (Ptr (This.Engine.ConM_World).all, This.Engine.ConM_Inputs.Constant_Reference); begin This := Next; end; - elsif This.Engine.ConM_World.Ptr.Engine.Kind = No_Gen then + elsif Ptr (This.Engine.ConM_World).Engine.Kind = No_Gen then This.Engine := (Kind => No_Gen); end if; end Roll_Conjunct_Many_Gen; @@ -429,9 +403,9 @@ package body Kompsos is procedure Roll_Recurse_Gen (This : in out World) is begin - This.Engine.Rec_World.Ptr.Rollover; - if This.Engine.Rec_World.Ptr.Possibles.Last_Index < This.Engine.Rec_Index then - if This.Engine.Rec_World.Ptr.Engine.Kind = No_Gen then + Ptr (This.Engine.Rec_World).Rollover; + if Ptr (This.Engine.Rec_World).Possibles.Last_Index < This.Engine.Rec_Index then + if Ptr (This.Engine.Rec_World).Engine.Kind = No_Gen then if This.Engine.Rec_Index = 1 then This.Engine := (Kind => No_Gen); else @@ -441,11 +415,11 @@ package body Kompsos is return; end if; for Index in Integer range - This.Engine.Rec_Index .. This.Engine.Rec_World.Ptr.Possibles.Last_Index + This.Engine.Rec_Index .. Ptr (This.Engine.Rec_World).Possibles.Last_Index loop - This.Possibles.Append (This.Engine.Rec_World.Ptr.Possibles (Index)); + This.Possibles.Append (Ptr (This.Engine.Rec_World).Possibles (Index)); end loop; - This.Engine.Rec_Index := This.Engine.Rec_World.Ptr.Possibles.Last_Index + 1; + This.Engine.Rec_Index := Ptr (This.Engine.Rec_World).Possibles.Last_Index + 1; end Roll_Recurse_Gen; @@ -609,8 +583,8 @@ package body Kompsos is Dis_World2 => Hold (Disjunct (Inputs (Inputs'First + 1 .. Inputs'Last))))) do Result.Next_Ident := ID_Number'Max - (Result.Engine.Dis_World1.Ptr.Next_Ident, - Result.Engine.Dis_World2.Ptr.Next_Ident); + (Ptr (Result.Engine.Dis_World1).Next_Ident, + Ptr (Result.Engine.Dis_World2).Next_Ident); end return; end if; end Disjunct; diff --git a/src/kompsos.ads b/src/kompsos.ads index 5a6af5f..cf4ba31 100644 --- a/src/kompsos.ads +++ b/src/kompsos.ads @@ -465,27 +465,25 @@ private - type World_Access is access World'Class; + type World_Root is abstract tagged null record; - type World_Holder is new Ada.Finalization.Controlled with record - Ptr : World_Access; - end record; - - overriding procedure Initialize - (This : in out World_Holder); - - overriding procedure Adjust - (This : in out World_Holder); + package World_Holders is new Ada.Containers.Indefinite_Holders (World_Root'Class); - overriding procedure Finalize - (This : in out World_Holder); + type World_Access is access all World; function Hold - (This : in World'Class) - return World_Holder; + (This : in World) + return World_Holders.Holder + with Inline; + + function Ptr + (This : in out World_Holders.Holder) + return World_Access + with Inline; procedure Swap - (Left, Right : in out World_Holder); + (Left, Right : in out World_Holders.Holder) + with Inline; type Generator_Kind is (No_Gen, @@ -503,30 +501,30 @@ private when No_Gen => null; when Fresh_Gen => - Frs_World : World_Holder; + Frs_World : World_Holders.Holder; Frs_Name : SU.Unbounded_String; when Unify_Gen => - Uni_World : World_Holder; + Uni_World : World_Holders.Holder; Uni_Term1 : Term; Uni_Term2 : Term; when Buffer_Gen => - Buff_World : World_Holder; + Buff_World : World_Holders.Holder; when Disjunct_Gen => - Dis_World1 : World_Holder; - Dis_World2 : World_Holder; + Dis_World1 : World_Holders.Holder; + Dis_World2 : World_Holders.Holder; when Conjunct_Zero_Gen => - ConZ_World : World_Holder; + ConZ_World : World_Holders.Holder; ConZ_Func : Conjunct_Zero_Func; when Conjunct_One_Gen => - ConO_World : World_Holder; + ConO_World : World_Holders.Holder; ConO_Func : Conjunct_One_Func; ConO_Input : Term; when Conjunct_Many_Gen => - ConM_World : World_Holder; + ConM_World : World_Holders.Holder; ConM_Func : Conjunct_Many_Func; ConM_Inputs : Term_Array_Holders.Holder; when Recurse_Gen => - Rec_World : World_Holder; + Rec_World : World_Holders.Holder; Rec_Index : Positive; end case; end record; @@ -535,7 +533,7 @@ private (Index_Type => Positive, Element_Type => State); - type World is tagged record + type World is new World_Root with record Possibles : State_Vectors.Vector; Next_Ident : ID_Number; Engine : Generator; |