on master help sign in
Make callback map updates strict
228601aRyan Trinkle
jsaddle/src/Language/Javascript/JSaddle/Run.hs+3−3
@@ -46,7 +46,7 @@ import Control.Concurrent (forkIO)
46import Control.Concurrent.STM.TChan
46import Control.Concurrent.STM.TChan
47 (tryReadTChan, TChan, readTChan, writeTChan, newTChanIO)
47 (tryReadTChan, TChan, readTChan, writeTChan, newTChanIO)
48import Control.Concurrent.STM.TVar
48import Control.Concurrent.STM.TVar
49− (writeTVar, readTVar, readTVarIO, modifyTVar, newTVarIO)
49+ (writeTVar, readTVar, readTVarIO, modifyTVar', newTVarIO)
50import Control.Concurrent.MVar
50import Control.Concurrent.MVar
51 (MVar, MVar, putMVar, takeMVar, newEmptyMVar)
51 (MVar, MVar, putMVar, takeMVar, newEmptyMVar)
52
52
@@ -151,8 +151,8 @@ runJavaScript sendBatch entryPoint = do
151 (ThrowJSValue (JSValueReceived v)) -> throwIO $ JSException (JSVal v)
151 (ThrowJSValue (JSValueReceived v)) -> throwIO $ JSException (JSVal v)
152 r -> return r
152 r -> return r
153 , doSendAsyncCommand = \cmd -> cmd `deepseq` atomically (writeTChan commandChan $ Left cmd)
153 , doSendAsyncCommand = \cmd -> cmd `deepseq` atomically (writeTChan commandChan $ Left cmd)
154− , addCallback = \(Object (JSVal val)) cb -> atomically $ modifyTVar callbacks (M.insert val cb)
154+ , addCallback = \(Object (JSVal val)) cb -> atomically $ modifyTVar' callbacks (M.insert val cb)
155− , freeCallback = \(Object (JSVal val)) -> atomically $ modifyTVar callbacks (M.delete val)
155+ , freeCallback = \(Object (JSVal val)) -> atomically $ modifyTVar' callbacks (M.delete val)
156 , nextRef = nextRef'
156 , nextRef = nextRef'
157 }
157 }
158 let processResults = \case
158 let processResults = \case