diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/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 diff --git a/inline-python.cabal b/inline-python.cabal --- a/inline-python.cabal +++ b/inline-python.cabal @@ -2,7 +2,7 @@ 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 diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs --- a/src/Python/Inline/Literal.hs +++ b/src/Python/Inline/Literal.hs @@ -577,7 +577,6 @@ -- [CU.exp| PyObject* { inline_py_callback_METH_NOARGS($(PyCFunction f_ptr)) } |] - -- | Only accepts positional parameters instance (FromPy a, Show a, ToPy b) => ToPy (a -> IO b) where basicToPy f = Py $ do @@ -600,6 +599,40 @@ -- [CU.exp| PyObject* { inline_py_callback_METH_FASTCALL($(PyCFunctionFast f_ptr)) } |] + +-- | Converted to 0-ary function +instance (ToPy b) => ToPy (Py b) where + basicToPy f = Py $ do + -- + f_ptr <- wrapCFunction $ \_ _ -> pyCallback $ do + progPy $ basicToPy =<< f + -- + [CU.exp| PyObject* { inline_py_callback_METH_NOARGS($(PyCFunction f_ptr)) } |] + +-- | Only accepts positional parameters +instance (FromPy a, Show a, ToPy b) => ToPy (a -> Py b) where + basicToPy f = Py $ do + -- + f_ptr <- wrapCFunction $ \_ p_a -> pyCallback $ do + a <- loadArg p_a 0 1 + progPy $ basicToPy =<< f a + -- + [CU.exp| PyObject* { inline_py_callback_METH_O($(PyCFunction f_ptr)) } |] + +-- | Only accepts positional parameters +instance (FromPy a1, FromPy a2, ToPy b) => ToPy (a1 -> a2 -> Py b) where + basicToPy f = Py $ do + -- + f_ptr <- wrapFastcall $ \_ p_arr n -> pyCallback $ do + when (n /= 2) $ abortM $ raiseBadNArgs 2 n + a1 <- loadArgFastcall p_arr 0 n + a2 <- loadArgFastcall p_arr 1 n + progPy $ basicToPy =<< f a1 a2 + -- + [CU.exp| PyObject* { inline_py_callback_METH_FASTCALL($(PyCFunctionFast f_ptr)) } |] + + + ---------------------------------------------------------------- -- Helpers ---------------------------------------------------------------- @@ -607,7 +640,7 @@ -- | Execute haskell callback function pyCallback :: Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject) -pyCallback io = callbackEnsurePyLock $ unPy $ ensureGIL $ runProgram io `catch` convertHaskell2Py +pyCallback io = callbackEnsurePyLock $ unsafeRunPy $ ensureGIL $ runProgram io `catch` convertHaskell2Py -- | Load argument from python object for haskell evaluation loadArg diff --git a/src/Python/Internal/Eval.hs b/src/Python/Internal/Eval.hs --- a/src/Python/Internal/Eval.hs +++ b/src/Python/Internal/Eval.hs @@ -15,7 +15,7 @@ -- * Evaluator , runPy , runPyInMain - , unPy + , unsafeRunPy -- * GC-related , newPyObject -- * C-API wrappers @@ -41,6 +41,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Cont import Data.Maybe +import Data.Function import Foreign.Concurrent qualified as GHC import Foreign.Ptr import Foreign.ForeignPtr @@ -273,13 +274,39 @@ initializePython :: IO () -- See NOTE: [Python and threading] initializePython = [CU.exp| int { Py_IsInitialized() } |] >>= \case - 0 | rtsSupportsBoundThreads -> runInBoundThread $ mask_ $ doInializePython - | otherwise -> mask_ $ doInializePython + 0 | rtsSupportsBoundThreads -> runInBoundThread $ doInializePython + | otherwise -> doInializePython _ -> pure () -- | Destroy python interpreter. finalizePython :: IO () -finalizePython = mask_ doFinalizePython +finalizePython = join $ atomically $ readTVar globalPyState >>= \case + NotInitialized -> throwSTM PythonNotInitialized + InitFailed -> throwSTM PythonIsFinalized + Finalized -> pure $ pure () + InInitialization -> retry + InFinalization -> retry + -- We can simply call Py_Finalize + Running1 -> checkLock $ [C.block| void { + PyGILState_Ensure(); + Py_Finalize(); + } |] + -- We need to call Py_Finalize on main thread + RunningN _ eval _ tid_gc -> checkLock $ do + killThread tid_gc + resp <- newEmptyMVar + putMVar eval $ StopReq resp + takeMVar resp + where + checkLock action = readTVar globalPyLock >>= \case + LockUninialized -> throwSTM $ PyInternalError "finalizePython LockUninialized" + LockFinalized -> throwSTM $ PyInternalError "finalizePython LockFinalized" + Locked{} -> retry + LockedByGC -> retry + LockUnlocked -> do + writeTVar globalPyLock LockFinalized + writeTVar globalPyState Finalized + pure action -- | Bracket which ensures that action is executed with properly -- initialized interpreter @@ -303,7 +330,6 @@ let fini st = atomically $ do writeTVar globalPyState $ st writeTVar globalPyLock $ LockUnlocked - pure $ (mask_ $ if -- On multithreaded runtime create bound thread to make @@ -335,22 +361,18 @@ putMVar lock_init r_init case r_init of False -> pure () - True -> mask_ $ do - let loop - = handle (\InterruptMain -> pure ()) - $ takeMVar lock_eval >>= \case - EvalReq py resp -> do - res <- (Right <$> runPy py) `catch` (pure . Left) - putMVar resp res - loop - StopReq resp -> do - [C.block| void { - PyGILState_Ensure(); - Py_Finalize(); - } |] - putMVar resp () - loop - + True -> mask_ $ fix $ \loop -> + takeMVar lock_eval >>= \case + EvalReq py resp -> do + res <- (Right <$> runPy py) `catch` (pure . Left) + putMVar resp res + loop + StopReq resp -> do + [C.block| void { + PyGILState_Ensure(); + Py_Finalize(); + } |] + putMVar resp () doInializePythonIO :: IO Bool @@ -401,36 +423,7 @@ } |] return $! r == 0 -doFinalizePython :: IO () -doFinalizePython = join $ atomically $ readTVar globalPyState >>= \case - NotInitialized -> throwSTM PythonNotInitialized - InitFailed -> throwSTM PythonIsFinalized - Finalized -> pure $ pure () - InInitialization -> retry - InFinalization -> retry - -- We can simply call Py_Finalize - Running1 -> checkLock $ [C.block| void { - PyGILState_Ensure(); - Py_Finalize(); - } |] - -- We need to call Py_Finalize on main thread - RunningN _ eval _ tid_gc -> checkLock $ do - killThread tid_gc - resp <- newEmptyMVar - putMVar eval $ StopReq resp - takeMVar resp - where - checkLock action = readTVar globalPyLock >>= \case - LockUninialized -> throwSTM $ PyInternalError "doFinalizePython LockUninialized" - LockFinalized -> throwSTM $ PyInternalError "doFinalizePython LockFinalized" - Locked{} -> retry - LockedByGC -> retry - LockUnlocked -> do - writeTVar globalPyLock LockFinalized - writeTVar globalPyState Finalized - pure action - ---------------------------------------------------------------- -- Running Py monad ---------------------------------------------------------------- @@ -454,7 +447,7 @@ where -- We check whether interpreter is initialized. Throw exception if -- it wasn't. Better than segfault isn't it? - go = ensurePyLock $ unPy (ensureGIL py) + go = ensurePyLock $ mask_ $ unsafeRunPy (ensureGIL py) -- | Same as 'runPy' but will make sure that code is run in python's -- main thread. It's thread in which python's interpreter was @@ -464,28 +457,56 @@ -- See NOTE: [Python and threading] runPyInMain py -- Multithreaded RTS - | rtsSupportsBoundThreads = join $ atomically $ readTVar globalPyState >>= \case + | rtsSupportsBoundThreads = do + tid <- myThreadId + bracket (acquireMain tid) fst snd + -- Single-threaded RTS + | otherwise = runPy py + where + 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 - $ flip finally (atomically (releaseLock tid_main)) - $ flip onException (throwTo tid_main InterruptMain) - $ do resp <- newEmptyMVar - putMVar eval $ EvalReq py resp - either throwM pure =<< takeMVar resp - -- Single-threaded RTS - | otherwise = runPy py + 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 + ) + -- + evalInOtherThread tid_main eval = do + r <- mask_ $ do resp <- newEmptyMVar + putMVar eval $ EvalReq py resp + takeMVar resp `onException` throwTo tid_main InterruptMain + either throwM pure r + -- | Execute python action. This function is unsafe and should be only -- called in thread of interpreter. -unPy :: Py a -> IO a -unPy (Py io) = io +unsafeRunPy :: Py a -> IO a +unsafeRunPy (Py io) = io diff --git a/test/TST/Callbacks.hs b/test/TST/Callbacks.hs --- a/test/TST/Callbacks.hs +++ b/test/TST/Callbacks.hs @@ -54,10 +54,21 @@ except TypeError as e: pass |] + ---------------------------------------- + , testCase "Py function(arity 0)" $ do + let fun = [pye| 0 |] + runPy [py_| assert fun_hs() == 0 |] + , testCase "Py function(arity=1)" $ runPy $ do + let double (n::Int) = [pye| n_hs * 2 |] + [py_| assert double_hs(3) == 6 |] + , testCase "Py function(arity=2)" $ runPy $ do + let foo (x::Int) (y::Int) = [pye| x_hs * y_hs |] + [py_| assert foo_hs(3, 100) == 300 |] + ---------------------------------------- , testCase "Haskell exception in callback(arity=1)" $ runPy $ do - let foo :: Int -> IO Int - foo y = pure $ 10 `div` y - throwsPy [py_| foo_hs(0) |] + 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 @@ -76,6 +87,21 @@ 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 diff --git a/test/TST/Run.hs b/test/TST/Run.hs --- a/test/TST/Run.hs +++ b/test/TST/Run.hs @@ -2,6 +2,8 @@ -- Tests for variable scope and names module TST.Run(tests) where +import Control.Concurrent +import Control.Exception import Control.Monad import Control.Monad.IO.Class import Test.Tasty @@ -15,11 +17,29 @@ [ 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() |] - , testCase "Python exceptions are converted" $ runPy $ throwsPy [py_| 1 / 0 |] + , testCase "Python exceptions are converted (py)" $ runPy $ throwsPy [py_| 1 / 0 |] + , testCase "Python exceptions are converted (std)" $ throwsPyIO $ runPy [py_| 1 / 0 |] + , testCase "Python exceptions are converted (main)" $ throwsPyIO $ runPyInMain [py_| 1 / 0 |] + , testCase "Main doesn't deadlock after exception" $ do + throwsPyIO $ runPyInMain [py_| 1 / 0 |] + runPyInMain [py_| assert True |] + -- Here we test that exceptions are really passed to python's thread without running python + , testCase "Exception in runPyInMain works" $ do + lock <- newEmptyMVar + tid <- myThreadId + _ <- forkIO $ takeMVar lock >> throwTo tid Stop + handle (\Stop -> pure ()) + $ runPyInMain + $ do liftIO $ putMVar lock () + liftIO $ threadDelay 10_000_000 + error "Should be interrupted" + runPyInMain $ pure () + -- , testCase "Scope pymain->any" $ runPy $ do [pymain| x = 12 @@ -112,3 +132,7 @@ pass |] ] + +data Stop = Stop + deriving stock Show + deriving anyclass Exception diff --git a/test/TST/Util.hs b/test/TST/Util.hs --- a/test/TST/Util.hs +++ b/test/TST/Util.hs @@ -12,3 +12,7 @@ throwsPy io = (io >> liftIO (assertFailure "Evaluation should raise python exception")) `catch` (\(_::PyError) -> pure ()) +throwsPyIO :: IO () -> IO () +throwsPyIO io = (io >> assertFailure "Evaluation should raise python exception") + `catch` (\(_::PyError) -> pure ()) +