diff options
| -rw-r--r-- | src/kompsos-collector.adb | 52 | ||||
| -rw-r--r-- | src/kompsos-collector.ads | 1 | ||||
| -rw-r--r-- | test/repeat.adb | 46 | ||||
| -rw-r--r-- | tests.gpr | 2 |
4 files changed, 68 insertions, 33 deletions
diff --git a/src/kompsos-collector.adb b/src/kompsos-collector.adb index 792c2b2..e8314ff 100644 --- a/src/kompsos-collector.adb +++ b/src/kompsos-collector.adb @@ -381,6 +381,11 @@ package body Kompsos.Collector is when Recurse_Node => if not Book.Contains (Ptr) then Book.Insert (Ptr, (Kind => Recurse_Data, others => <>)); + if Ptr.Rec_Goal.Actual = null then + Book (Ptr).Rec_Gone := True; + elsif not Cache_Memo.Contains (Ptr.Rec_Goal.Actual) then + Cache_Memo.Insert (Ptr.Rec_Goal.Actual, State_Vectors.Empty_Vector); + end if; end if; if Book (Ptr).Rec_Gone then return False; @@ -396,44 +401,18 @@ package body Kompsos.Collector is return False; else Book (Ptr).Rec_Next := 1; + Book (Ptr).Rec_Cache := False; end if; end loop; + if Book (Ptr).Rec_Cache and Ptr.Rec_Goal.Actual.Counter = 1 then + Cache_Memo (Ptr.Rec_Goal.Actual).Append (Result); + end if; Book (Ptr).Rec_Next := Book.Element (Ptr).Rec_Next + 1; return True; end case; end Do_Get_Next; - function Cached - (Ptr : in Goal_Component_Access; - Index : in Long_Positive; - Result : out State) - return Boolean is - begin - if Cache_Memo.Contains (Ptr) and then Index <= Cache_Memo (Ptr).Last_Index then - Result := Cache_Memo (Ptr) (Index); - return True; - else - return False; - end if; - end Cached; - - - procedure Cache_This - (Ptr : in Goal_Component_Access; - Index : in Long_Positive; - Result : in State) is - begin - if Ptr.Counter > 1 and Ptr.Kind /= Static_Node then - if not Cache_Memo.Contains (Ptr) then - Cache_Memo.Insert (Ptr, State_Vectors.Empty_Vector); - end if; - pragma Assert (Index = Cache_Memo (Ptr).Last_Index + 1); - Cache_Memo (Ptr).Append (Result); - end if; - end Cache_This; - - function Get_Next (Ptr : in Constant_Goal_Access; Base : in State; @@ -443,12 +422,19 @@ package body Kompsos.Collector is begin if Ptr = null or else Ptr.Actual = null then return False; - elsif Cached (Ptr.Actual, Index, Result) then + elsif Cache_Memo.Contains (Ptr.Actual) and then + Index <= Cache_Memo (Ptr.Actual).Last_Index + then + Result := Cache_Memo (Ptr.Actual) (Index); return True; else return Found : constant Boolean := Do_Get_Next (Ptr.Actual, Base, Index, Result) do - if Found then - Cache_This (Ptr.Actual, Index, Result); + if Found and Ptr.Actual.Counter > 1 and Ptr.Actual.Kind /= Static_Node then + if not Cache_Memo.Contains (Ptr.Actual) then + Cache_Memo.Insert (Ptr.Actual, State_Vectors.Empty_Vector); + end if; + pragma Assert (Index = Cache_Memo (Ptr.Actual).Last_Index + 1); + Cache_Memo (Ptr.Actual).Append (Result); end if; end return; end if; diff --git a/src/kompsos-collector.ads b/src/kompsos-collector.ads index 2b175a1..cbe8dd7 100644 --- a/src/kompsos-collector.ads +++ b/src/kompsos-collector.ads @@ -69,6 +69,7 @@ private when Recurse_Data => Rec_Next : Long_Positive := 1; Rec_Gone : Boolean := False; + Rec_Cache : Boolean := True; end case; end record; diff --git a/test/repeat.adb b/test/repeat.adb new file mode 100644 index 0000000..0eec066 --- /dev/null +++ b/test/repeat.adb @@ -0,0 +1,46 @@ + + +-- Programmed by Jedidiah Barber +-- Licensed under the Sunset License v1.0 + +-- See license.txt for further details + + +with + + Ada.Text_IO, + Kompsos.Pretty_Print; + + +procedure Repeat is + + package TIO renames Ada.Text_IO; + + + package InKomp is new Kompsos (Integer); + use InKomp; + + package Printer is new InKomp.Pretty_Print (Integer'Image); + + + Relation : Goal := Empty_Goal; + + A : constant Term := Relation.Fresh; + B : constant Term := Relation.Fresh; + +begin + + TIO.Put_Line ("Test program to check whether Recurse is working properly."); + TIO.Put_Line ("There should be 5 results, all identical."); + + TIO.New_Line; + + Relation := Disjunct (Relation.Unify (A, 1), Relation.Unify (B, 2)); + Relation.Unify (A, 3); + Relation.Recurse; + + TIO.Put_Line (Printer.Image (Relation.Run (5))); + +end Repeat; + + @@ -27,6 +27,7 @@ project Tests is "multo.adb", "pprint.adb", "rembero.adb", + "repeat.adb", "trees.adb"); package Builder is @@ -41,6 +42,7 @@ project Tests is for Executable ("multo.adb") use "multo"; for Executable ("pprint.adb") use "pprint"; for Executable ("rembero.adb") use "rembero"; + for Executable ("repeat.adb") use "repeat"; for Executable ("trees.adb") use "trees"; for Default_Switches ("Ada") use |