%%
%% A thread-safe implementation of an LRU-like cache.
%% No upper bound in size.
%% All entries are removed after they have not been requested for a defined time period.
%%
functor
import
   Property(get)
\ifndef NO_TESTING
   Application
   System
\endif
export
   Create
define
   %% Provider: a one-argument lookup function which may throw in case of failure.
   %% Not requested items are discarded after Milliseconds,
   %% at the latest after 2*Milliseconds.
   %% Returns a function that delivers an item for a key
   %% (or a failed value if lookup failed).
   %% Clear: procedure to clear the cache
   fun {Create Provider Milliseconds ?Clear}
      SharedPort
      thread
	 Cache = {NewCell {NewDictionary}}
	 MinimizerThread = {NewCell unit}
      in
	 for Request#Result in {NewPort $ SharedPort} do
	    try {Thread.terminate @MinimizerThread} catch _ then skip end
	    case Request of get(Key) then
	       Result = {Dictionary.condGet @Cache Key
			 {Value.byNeed
			  fun {$}
			     try
				{Provider Key}#0
			     catch E then {Value.failed E}
			     end
			  end}
			}.1
	       if {Not {Value.isFailed Result}} then
		  (@Cache).Key := Result#{Now} end
	    [] clear then
	       Cache := {NewDictionary}
	       Result = unit
	    end
	    MinimizerThread := {StartMinimizer Cache Milliseconds}
	 end
      end
   in
      proc {Clear} {Wait {Port.sendRecv SharedPort clear}} end
      fun {$ Key}
	 Res = {Port.sendRecv SharedPort get(Key)}
      in
	 {Wait Res}
	 Res
      end
   end

   proc {StartMinimizer Cache Milliseconds TId}
      proc {Minimizer}
	 local
	    N = {Now}
	    RemainingEntries =
	    {Filter {Dictionary.entries @Cache}
	     fun {$ _#(_#TS)} N - TS < Milliseconds end
	    }
	 in
	    Cache := {ListToDictionary RemainingEntries}
	 end
	 %% the time specified here is also the maximum time that an object can stay
	 %% in the cash for too long
	 {Delay Milliseconds}
	 {Minimizer}
      end
   in
      thread
	 TId = {Thread.this}
	 {Minimizer}
      end
   end

   fun {Now} {Property.get 'time.total'} end

   fun {ListToDictionary Xs}
      D = {NewDictionary}
   in
      {ForAll Xs proc {$ K#V} D.K := V end}
      D
   end

\ifndef NO_TESTING
   {System.showInfo "Testing module Cache"}
   for T in [50 100 500] do
      local
	 Called = {NewCell false}
	 fun {Id X} Called := true X end
	 Clear
	 C = {Create Id T ?Clear}
      in
	 %% Provider is called when first accessing a key
	 {C 42} = 42
	 @Called = true
	 %% Provider is not called within half the cache time (even repeatedly)
	 for _ in [1 2 3 4] do
	    Called := false
	    {Delay T div 2}
	    {C 42} = 42
	    @Called = false
	 end
	 %% Provider is called again after double the cache time
	 {Delay T*2}
	 {C 42} = 42
	 @Called = true

	 %% Provider is called after eplicit Clear
	 {C 21} = 21
	 {Clear}
	 Called := false
	 {C 21} = 21
	 @Called = true
      end
   end
   {System.showInfo "done"}
   {Application.exit 0}
\endif
end

Thread-safe lru-like cache in Oz/Mozart.

cache

Other