Fix many deadlock in runPyInMain

ChangeLog.md

@@ -0,0 +1,12 @@
+0.1.1 [2025.02.13]
+------------------
+* Number of deadlocks in `runPyInMain` fixed:
+  - It no longer deadlocks is exception is thrown
+  - Nested calls no longer deadlock.
+  - Calling it from python callback.
+* `ToPy` instance added for `Py b`, `a -> Py b`, `a1 -> a2 -> Py b`
+
+
+0.1 [2025.01.18]
+----------------
+Initial release

inline-python.cabal

@@ -2,7 +2,7 @@ Cabal-Version:  3.0
 Build-Type:     Simple
 
 Name:           inline-python
-Version:        0.1
+Version:        0.1.1
 Synopsis:       Python interpreter embedded into haskell.
 Description:
   This package embeds python interpreter into haskell program and

src/Python/Internal/Eval.hs

@@ -457,23 +457,46 @@ runPyInMain :: Py a -> IO a
 -- See NOTE: [Python and threading]
 runPyInMain py
   -- Multithreaded RTS
-  | rtsSupportsBoundThreads = bracket acquireMain releaseMain evalMain
+  | rtsSupportsBoundThreads = do
+      tid <- myThreadId
+      bracket (acquireMain tid) fst snd
   -- Single-threaded RTS
   | otherwise = runPy py
   where
-    acquireMain = atomically $ readTVar globalPyState >>= \case
+    acquireMain tid = atomically $ readTVar globalPyState >>= \case
       NotInitialized   -> throwSTM PythonNotInitialized
       InitFailed       -> throwSTM PyInitializationFailed
       Finalized        -> throwSTM PythonIsFinalized
       InInitialization -> retry
       InFinalization   -> retry
       Running1         -> throwSTM $ PyInternalError "runPyInMain: Running1"
-      RunningN _ eval tid_main _ -> do
-        acquireLock tid_main
-        pure (tid_main, eval)
+      RunningN _ eval tid_main _ -> readTVar globalPyLock >>= \case
+        LockUninialized -> throwSTM PythonNotInitialized
+        LockFinalized   -> throwSTM PythonIsFinalized
+        LockedByGC      -> retry
+        -- We need to send closure to main python thread when we're grabbing lock.
+        LockUnlocked    -> do
+          writeTVar globalPyLock $ Locked tid_main []
+          pure ( atomically (releaseLock tid_main)
+               , evalInOtherThread tid_main eval
+               )
+        -- If we can grab lock and main thread taken lock we're
+        -- already executing on main thread. We can simply execute code
+        Locked t ts
+          | t /= tid
+            -> retry
+          | t == tid_main || (tid_main `elem` ts) -> do
+              writeTVar globalPyLock $ Locked t (t : ts)
+              pure ( atomically (releaseLock t)
+                   , unsafeRunPy $ ensureGIL py
+                   )
+          | otherwise -> do
+              writeTVar globalPyLock $ Locked tid_main (t : ts)
+              pure ( atomically (releaseLock tid_main)
+                   , evalInOtherThread tid_main eval
+                   )
     --
-    releaseMain (tid_main, _   ) = atomically (releaseLock tid_main)
-    evalMain    (tid_main, eval) = do
+    evalInOtherThread tid_main eval = do
       r <- mask_ $ do resp <- newEmptyMVar
                       putMVar eval $ EvalReq py resp
                       takeMVar resp `onException` throwTo tid_main InterruptMain

test/TST/Callbacks.hs

@@ -69,44 +69,59 @@ tests = testGroup "Callbacks"
        let foo :: Int -> IO Int
            foo y = pure $ 10 `div` y
        throwsPy [py_| foo_hs(0) |]
-   , testCase "Haskell exception in callback(arity=2)" $ runPy $ do
-       let foo :: Int -> Int -> IO Int
-           foo x y = pure $ x `div` y
-       throwsPy [py_| foo_hs(1, 0) |]
-     ----------------------------------------
-   , testCase "Call python in callback (arity=1)" $ runPy $ do
-       let foo :: Int -> IO Int
-           foo x = do Just x' <- runPy $ fromPy =<< [pye| 100 // x_hs |]
-                      pure x'
-       [py_|
-         assert foo_hs(5) == 20
-         |]
-   , testCase "Call python in callback (arity=2" $ runPy $ do
-       let foo :: Int -> Int -> IO Int
-           foo x y = do Just x' <- runPy $ fromPy =<< [pye| x_hs // y_hs |]
-                        pure x'
-       [py_|
-         assert foo_hs(100,5) == 20
-         |]
-     ----------------------------------------
-   , testCase "No leaks (arity=1)" $ runPy $ do
-       let foo :: Int -> IO Int
-           foo y = pure $ 10 * y
-       [py_|
-         import sys
-         x = 123456
-         old_refcount = sys.getrefcount(x)
-         foo_hs(x)
-         assert old_refcount == sys.getrefcount(x)
-         |]
-   , testCase "No leaks (arity=2)" $ runPy $ do
-       let foo :: Int -> Int -> IO Int
-           foo x y = pure $ x * y
-       [py_|
-         import sys
-         x = 123456
-         old_refcount = sys.getrefcount(x)
-         foo_hs(1,x)
-         assert old_refcount == sys.getrefcount(x)
-         |]
-   ]
+  , testCase "Haskell exception in callback(arity=2)" $ runPy $ do
+      let foo :: Int -> Int -> IO Int
+          foo x y = pure $ x `div` y
+      throwsPy [py_| foo_hs(1, 0) |]
+    ----------------------------------------
+  , testCase "Call python in callback (arity=1)" $ runPy $ do
+      let foo :: Int -> IO Int
+          foo x = do Just x' <- runPy $ fromPy =<< [pye| 100 // x_hs |]
+                     pure x'
+      [py_|
+        assert foo_hs(5) == 20
+        |]
+  , testCase "Call python in callback (arity=2" $ runPy $ do
+      let foo :: Int -> Int -> IO Int
+          foo x y = do Just x' <- runPy $ fromPy =<< [pye| x_hs // y_hs |]
+                       pure x'
+      [py_|
+        assert foo_hs(100,5) == 20
+        |]
+    ----------------------------------------
+  , testCase "runPyInMain in runPyInMain (arity=1)" $ do
+      let foo :: Int -> IO Int
+          foo x = do Just x' <- runPyInMain $ fromPy =<< [pye| 100 // x_hs |]
+                     pure x'
+      runPyInMain [py_|
+        assert foo_hs(5) == 20
+        |]
+  , testCase "runPyInMain in runPy (arity=1)" $ do
+      let foo :: Int -> IO Int
+          foo x = do Just x' <- runPyInMain $ fromPy =<< [pye| 100 // x_hs |]
+                     pure x'
+      runPy [py_|
+        assert foo_hs(5) == 20
+        |]
+    ----------------------------------------
+  , testCase "No leaks (arity=1)" $ runPy $ do
+      let foo :: Int -> IO Int
+          foo y = pure $ 10 * y
+      [py_|
+        import sys
+        x = 123456
+        old_refcount = sys.getrefcount(x)
+        foo_hs(x)
+        assert old_refcount == sys.getrefcount(x)
+        |]
+  , testCase "No leaks (arity=2)" $ runPy $ do
+      let foo :: Int -> Int -> IO Int
+          foo x y = pure $ x * y
+      [py_|
+        import sys
+        x = 123456
+        old_refcount = sys.getrefcount(x)
+        foo_hs(1,x)
+        assert old_refcount == sys.getrefcount(x)
+        |]
+  ]

test/TST/Run.hs

@@ -17,6 +17,7 @@ tests = testGroup "Run python"
   [ testCase "Empty QQ" $ runPy [py_| |]
   , testCase "Second init is noop" $ initializePython
   , testCase "Nested runPy" $ runPy $ liftIO $ runPy $ pure ()
+  , testCase "Nested runPyInMain" $ runPyInMain $ liftIO $ runPyInMain $ pure ()
   , testCase "runPyInMain" $ runPyInMain $ [py_|
       import threading
       assert threading.main_thread() == threading.current_thread()