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


/ Published in: Other
Save to your folder(s)



Copy this code and paste it in your HTML
  1. %%
  2. %% A thread-safe implementation of an LRU-like cache.
  3. %% No upper bound in size.
  4. %% All entries are removed after they have not been requested for a defined time period.
  5. %%
  6. functor
  7. import
  8. Property(get)
  9. \ifndef NO_TESTING
  10. Application
  11. System
  12. \endif
  13. export
  14. Create
  15. define
  16. %% Provider: a one-argument lookup function which may throw in case of failure.
  17. %% Not requested items are discarded after Milliseconds,
  18. %% at the latest after 2*Milliseconds.
  19. %% Returns a function that delivers an item for a key
  20. %% (or a failed value if lookup failed).
  21. %% Clear: procedure to clear the cache
  22. fun {Create Provider Milliseconds ?Clear}
  23. SharedPort
  24. thread
  25. Cache = {NewCell {NewDictionary}}
  26. MinimizerThread = {NewCell unit}
  27. in
  28. for Request#Result in {NewPort $ SharedPort} do
  29. try {Thread.terminate @MinimizerThread} catch _ then skip end
  30. case Request of get(Key) then
  31. Result = {Dictionary.condGet @Cache Key
  32. {Value.byNeed
  33. fun {$}
  34. try
  35. {Provider Key}#0
  36. catch E then {Value.failed E}
  37. end
  38. end}
  39. }.1
  40. if {Not {Value.isFailed Result}} then
  41. (@Cache).Key := Result#{Now} end
  42. [] clear then
  43. Cache := {NewDictionary}
  44. Result = unit
  45. end
  46. MinimizerThread := {StartMinimizer Cache Milliseconds}
  47. end
  48. end
  49. in
  50. proc {Clear} {Wait {Port.sendRecv SharedPort clear}} end
  51. fun {$ Key}
  52. Res = {Port.sendRecv SharedPort get(Key)}
  53. in
  54. {Wait Res}
  55. Res
  56. end
  57. end
  58.  
  59. proc {StartMinimizer Cache Milliseconds TId}
  60. proc {Minimizer}
  61. local
  62. N = {Now}
  63. RemainingEntries =
  64. {Filter {Dictionary.entries @Cache}
  65. fun {$ _#(_#TS)} N - TS < Milliseconds end
  66. }
  67. in
  68. Cache := {ListToDictionary RemainingEntries}
  69. end
  70. %% the time specified here is also the maximum time that an object can stay
  71. %% in the cash for too long
  72. {Delay Milliseconds}
  73. {Minimizer}
  74. end
  75. in
  76. thread
  77. TId = {Thread.this}
  78. {Minimizer}
  79. end
  80. end
  81.  
  82. fun {Now} {Property.get 'time.total'} end
  83.  
  84. fun {ListToDictionary Xs}
  85. D = {NewDictionary}
  86. in
  87. {ForAll Xs proc {$ K#V} D.K := V end}
  88. D
  89. end
  90.  
  91. \ifndef NO_TESTING
  92. {System.showInfo "Testing module Cache"}
  93. for T in [50 100 500] do
  94. local
  95. Called = {NewCell false}
  96. fun {Id X} Called := true X end
  97. Clear
  98. C = {Create Id T ?Clear}
  99. in
  100. %% Provider is called when first accessing a key
  101. {C 42} = 42
  102. @Called = true
  103. %% Provider is not called within half the cache time (even repeatedly)
  104. for _ in [1 2 3 4] do
  105. Called := false
  106. {Delay T div 2}
  107. {C 42} = 42
  108. @Called = false
  109. end
  110. %% Provider is called again after double the cache time
  111. {Delay T*2}
  112. {C 42} = 42
  113. @Called = true
  114.  
  115. %% Provider is called after eplicit Clear
  116. {C 21} = 21
  117. {Clear}
  118. Called := false
  119. {C 21} = 21
  120. @Called = true
  121. end
  122. end
  123. {System.showInfo "done"}
  124. {Application.exit 0}
  125. \endif
  126. end

Report this snippet


Comments

RSS Icon Subscribe to comments

You need to login to post a comment.