diff options
| -rw-r--r-- | src/kompsos-collector.adb | 80 | ||||
| -rw-r--r-- | src/kompsos-collector.ads | 31 |
2 files changed, 71 insertions, 40 deletions
diff --git a/src/kompsos-collector.adb b/src/kompsos-collector.adb index 592979f..7d48196 100644 --- a/src/kompsos-collector.adb +++ b/src/kompsos-collector.adb @@ -14,6 +14,23 @@ with package body Kompsos.Collector is + ---------------------- + -- Progress State -- + ---------------------- + + Cache : Cache_Maps.Map; + Book : Eval_Maps.Map; + + Global_Var : Variable := Relation.Next_Var; + + Next_Index : Long_Positive := 1; + Next_State : State; + State_Valid : Boolean := False; + Exhausted : Boolean := False; + + + + ------------------------- -- Memory Management -- ------------------------- @@ -22,9 +39,14 @@ package body Kompsos.Collector is procedure Free is new Ada.Unchecked_Deallocation (State, State_Access); procedure Finalize - (This : in out Managed_Map) is + (This : in out Collector_Final_Controller) is begin - for Datum of This.Actual loop + for Memo of Cache loop + for Line of Memo.Data loop + Free (Line.Data); + end loop; + end loop; + for Datum of Book loop if Datum.Kind = Conjunct_Data then Free (Datum.Con_Base); Free (Datum.Con_Part); @@ -35,25 +57,6 @@ package body Kompsos.Collector is - ---------------------- - -- Progress State -- - ---------------------- - - Cache_Memo : Cache_Maps.Map := Cache_Maps.Empty_Map; - Bookkeep : Managed_Map := (Ada.Finalization.Controlled with Actual => Eval_Maps.Empty_Map); - - Book : Eval_Maps.Map renames Bookkeep.Actual; - - Global_Var : Variable := Relation.Next_Var; - - Next_Index : Long_Positive := 1; - Next_State : State; - State_Valid : Boolean := False; - Exhausted : Boolean := False; - - - - ------------------------ -- Internal Helpers -- ------------------------ @@ -151,7 +154,12 @@ package body Kompsos.Collector is return; end if; - Cache_Memo.Exclude (Ptr.Actual); + if Cache.Contains (Ptr.Actual) then + for Line of Cache (Ptr.Actual).Data loop + Free (Line.Data); + end loop; + Cache.Delete (Ptr.Actual); + end if; case Ptr.Actual.Kind is when Unify_Node => @@ -354,8 +362,10 @@ package body Kompsos.Collector is Book.Insert (Ptr, (Kind => Recurse_Data, others => <>)); if Ptr.Rec_Goal.Actual = null then Book (Ptr).Rec_Cache := False; - elsif not Cache_Memo.Contains (Ptr.Rec_Goal.Actual) then - Cache_Memo.Insert (Ptr.Rec_Goal.Actual, State_Vectors.Empty_Vector); + elsif not Cache.Contains (Ptr.Rec_Goal.Actual) then + Cache.Insert (Ptr.Rec_Goal.Actual, (True, State_Vectors.Empty_Vector)); + else + Cache (Ptr.Rec_Goal.Actual).Keep := True; end if; end if; if Book (Ptr).Rec_Gone then @@ -376,7 +386,7 @@ package body Kompsos.Collector is 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); + Cache (Ptr.Rec_Goal.Actual).Data.Append ((1, new State'(Result))); end if; Book (Ptr).Rec_Next := Book.Element (Ptr).Rec_Next + 1; return True; @@ -400,19 +410,25 @@ package body Kompsos.Collector is else return False; end if; - elsif Cache_Memo.Contains (Ptr.Actual) and then - Index <= Cache_Memo (Ptr.Actual).Last_Index + elsif Cache.Contains (Ptr.Actual) and then + Index <= Cache (Ptr.Actual).Data.Last_Index then - Result := Cache_Memo (Ptr.Actual) (Index); + Result := Cache (Ptr.Actual).Data (Index).Data.all; + Cache (Ptr.Actual).Data (Index).Used := Cache (Ptr.Actual).Data (Index).Used + 1; + if not Cache (Ptr.Actual).Keep and then + Natural (Cache (Ptr.Actual).Data (Index).Used) >= Ptr.Actual.Counter + then + Free (Cache (Ptr.Actual).Data (Index).Data); + end if; return True; else return Found : constant Boolean := Do_Get_Next (Ptr.Actual, Base, Index, Result) do if Found and Ptr.Actual.Counter > 1 then - if not Cache_Memo.Contains (Ptr.Actual) then - Cache_Memo.Insert (Ptr.Actual, State_Vectors.Empty_Vector); + if not Cache.Contains (Ptr.Actual) then + Cache.Insert (Ptr.Actual, (False, State_Vectors.Empty_Vector)); end if; - pragma Assert (Index = Cache_Memo (Ptr.Actual).Last_Index + 1); - Cache_Memo (Ptr.Actual).Append (Result); + pragma Assert (Index = Cache (Ptr.Actual).Data.Last_Index + 1); + Cache (Ptr.Actual).Data.Append ((1, new State'(Result))); end if; end return; end if; diff --git a/src/kompsos-collector.ads b/src/kompsos-collector.ads index b58721a..d352fa3 100644 --- a/src/kompsos-collector.ads +++ b/src/kompsos-collector.ads @@ -46,6 +46,8 @@ private type State_Access is access State; + + type Eval_Kind is (Unify_Data, Disjunct_Data, @@ -79,23 +81,36 @@ private (Key_Type => Graph_Component_Access, Element_Type => Eval_Data); - type Managed_Map is new Ada.Finalization.Controlled with record - Actual : Eval_Maps.Map; - end record; - overriding procedure Finalize - (This : in out Managed_Map); + subtype Short_Positive is Short_Integer range 1 .. Short_Integer'Last; + type Cached_State is record + Used : Short_Positive; + Data : State_Access; + end record; package State_Vectors is new Ada.Containers.Vectors (Index_Type => Long_Positive, - Element_Type => State); + Element_Type => Cached_State); + + type Cache_Entry is record + Keep : Boolean; + Data : State_Vectors.Vector; + end record; package Cache_Maps is new Ada.Containers.Ordered_Maps (Key_Type => Graph_Component_Access, - Element_Type => State_Vectors.Vector, - "=" => State_Vectors."="); + Element_Type => Cache_Entry); + + + + type Collector_Final_Controller is new Ada.Finalization.Limited_Controlled with null record; + + overriding procedure Finalize + (This : in out Collector_Final_Controller); + + Cleanup : Collector_Final_Controller; end Kompsos.Collector; |