atMost API

[kazu-yamamoto]

I'm planning to replace GHC's PSQ file in concurrent-dns-cache with psqueues. One missing API is atMost: https://github.com/ghc/ghc/blob/master/libraries/base/GHC/Event/PSQ.hs#L266

It would be great if atMost will be implemented.

[kazu-yamamoto]

Ping.
I really want this API.

[jaspervdj]

Thanks for pinging. I have a long train ride ahead of me today so I should be able to give it a look. On Jun 28, 2017 12:57, "Kazu Yamamoto" <[email protected]> wrote: Ping. I really want this API. — You are receiving this because you are subscribed to this thread. Reply to this email directly, view it on GitHub <#18 (comment)>, or mute the thread <https://github.com/notifications/unsubscribe-auth/AAF1DSKPpPYSwphbc-0IUlbpF336CDbyks5sId0pgaJpZM4MN_rl> .

[jaspervdj]

@kazu-yamamoto Do you need the elements in the first element of the returned tupled to be ordered by key? The GHC PSQ promises this and I think it's perhaps doable (but tricky) for our versions, but it's not sensible for at least HashPSQ. That means I'd rather not provide it if it's not necessary, so the three versions have a consistent interface.

I've added this function (without the key ordering) to the atmost branch.

[kazu-yamamoto]

I don't care the ordering of the first element because I use only the second element to implement caches.

I will try the atmost branch today. Thank you for your effort!

[kazu-yamamoto]

atMostView works well.
I hope you will release the new version soon.

[jaspervdj]

I should be able to release the new version tomorrow..

[kazu-yamamoto]

I can't wait! 👍

[jaspervdj]

Released as 0.2.3.0 on Hackage.

[alexbiehl]

@kazu-yamamoto Do you think it would be worthwile to borrow the IntPSQ implementation and use it for GHCs timer manager?

[kazu-yamamoto]

@jaspervdj Than you. I appreciate.

[kazu-yamamoto]

@alexbiehl Yes. If you do so, please also consider to merge the following patch to GHC. We don't have to wake up the time manager when the PSQ root is not changed.

diff --git a/libraries/base/GHC/Event/TimerManager.hs b/libraries/base/GHC/Event/TimerManager.hs
index c1ab64c..9407098 100644
--- a/libraries/base/GHC/Event/TimerManager.hs
+++ b/libraries/base/GHC/Event/TimerManager.hs
@@ -219,14 +219,12 @@ registerTimeout mgr us cb = do
       let expTime = fromIntegral us / 1000000.0 + now
 
       editTimeouts mgr (Q.insert key expTime cb)
-      wakeManager mgr
   return $ TK key
 
 -- | Unregister an active timeout.
 unregisterTimeout :: TimerManager -> TimeoutKey -> IO ()
 unregisterTimeout mgr (TK key) = do
   editTimeouts mgr (Q.delete key)
-  wakeManager mgr
 
 -- | Update an active timeout to fire in the given number of
 -- microseconds.
@@ -236,8 +234,19 @@ updateTimeout mgr (TK key) us = do
   let expTime = fromIntegral us / 1000000.0 + now
 
   editTimeouts mgr (Q.adjust (const expTime) key)
-  wakeManager mgr
 
 editTimeouts :: TimerManager -> TimeoutEdit -> IO ()
-editTimeouts mgr g = atomicModifyIORef' (emTimeouts mgr) $ \tq -> (g tq, ())
-
+editTimeouts mgr g = do
+    wake <- atomicModifyIORef' (emTimeouts mgr) f
+    when wake $ wakeManager mgr
+  where
+    f q = (q', wake)
+      where
+        q' = g q
+        wake = case Q.minView q of
+            Nothing              -> True
+            Just (Q.E _ t0 _, _) -> case Q.minView q' of
+                Nothing          -> False -- just in case
+                Just (Q.E _ t1 _, _)
+                  | t0 == t1     -> False
+                  | otherwise    -> True