From dd89be005dca957a9ae2accc0cb49c41ba9c1767 Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 15:54:54 +0300
Subject: [PATCH 01/13] Python should not install signal handlers

---
 src/Python/Internal/Eval.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Python/Internal/Eval.hs b/src/Python/Internal/Eval.hs
index 4e1222d..ead9439 100644
--- a/src/Python/Internal/Eval.hs
+++ b/src/Python/Internal/Eval.hs
@@ -274,7 +274,8 @@ doInializePython = do
       PyStatus status;
       PyConfig cfg;
       PyConfig_InitPythonConfig( &cfg );
-      cfg.parse_argv = 0;
+      cfg.parse_argv              = 0;
+      cfg.install_signal_handlers = 0;
       //----------------
       status = PyConfig_SetBytesString(&cfg, &cfg.program_name, "XX");
       if( PyStatus_Exception(status) ) {

From 55aa8c6fc86c95ce6005ca132dec3101681e453f Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 16:02:13 +0300
Subject: [PATCH 02/13] Add typedefs for function ptrs for inline-c

---
 src/Python/Inline/Literal.hs | 11 +++--------
 src/Python/Internal/Types.hs |  8 +++++++-
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs
index cf9c1bc..1656e1b 100644
--- a/src/Python/Inline/Literal.hs
+++ b/src/Python/Inline/Literal.hs
@@ -293,10 +293,8 @@ instance (FromPy a, Show a, ToPy b) => ToPy (a -> IO b) where
         Right a            -> pure a
       liftIO $ unPy . basicToPy =<< f a
     --
-    [CU.block| PyObject* {
-      inline_py_callback_METH_O(
-          $(PyObject* (*f_ptr)(PyObject*, PyObject*)));
-      }|]
+    [CU.exp| PyObject* { inline_py_callback_METH_O($(PyCFunction f_ptr)) } |]
+
 
 instance (FromPy a1, FromPy a2, ToPy b) => ToPy (a1 -> a2 -> IO b) where
   basicToPy f = Py $ do
@@ -307,10 +305,7 @@ instance (FromPy a1, FromPy a2, ToPy b) => ToPy (a1 -> a2 -> IO b) where
       b <- loadArgFastcall p_arr 1 n
       liftIO $ unPy . basicToPy =<< f a b
     -- Create python function
-    [C.block| PyObject* {
-      PyCFunctionFast impl = $(PyObject* (*f_ptr)(PyObject*, PyObject*const*, int64_t));
-      return inline_py_callback_METH_FASTCALL(impl);
-      }|]
+    [C.exp| PyObject* { inline_py_callback_METH_FASTCALL($(PyCFunctionFast f_ptr)) } |]
 
 loadArgFastcall :: FromPy a => Ptr (Ptr PyObject) -> Int -> Int64 -> Program (Ptr PyObject) a
 loadArgFastcall p_arr i tot = do
diff --git a/src/Python/Internal/Types.hs b/src/Python/Internal/Types.hs
index da3e49d..86d2f6d 100644
--- a/src/Python/Internal/Types.hs
+++ b/src/Python/Internal/Types.hs
@@ -27,6 +27,7 @@ module Python.Internal.Types
 import Control.Exception
 import Control.Monad.IO.Class
 import Data.Coerce
+import Data.Int
 import Data.Map.Strict           qualified as Map
 import Foreign.Ptr
 import Foreign.ForeignPtr
@@ -89,7 +90,12 @@ tryPy = coerce (try @e @a)
 pyCtx :: Context
 pyCtx = mempty { ctxTypesTable = Map.fromList tytabs } where
   tytabs =
-    [ (TypeName "PyObject", [t| PyObject |])
+    [ ( TypeName "PyObject"
+      , [t| PyObject |])
+    , ( TypeName "PyCFunction"
+      , [t| FunPtr (Ptr PyObject -> Ptr PyObject -> IO (Ptr PyObject)) |])
+    , ( TypeName "PyCFunctionFast"
+      , [t| FunPtr (Ptr PyObject -> Ptr (Ptr PyObject) -> Int64 -> IO (Ptr PyObject)) |])
     ]
 
 

From d4570ad1d71fd800e37450b24553c6404930d28a Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 16:45:44 +0300
Subject: [PATCH 03/13] Again change semantic of basicToPy

Return NULL to signal python errors
---
 src/Python/Inline/Literal.hs   | 49 +++++++++++++++++++---------------
 src/Python/Internal/Program.hs |  7 +++++
 2 files changed, 34 insertions(+), 22 deletions(-)

diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs
index 1656e1b..b447f8b 100644
--- a/src/Python/Inline/Literal.hs
+++ b/src/Python/Inline/Literal.hs
@@ -19,7 +19,6 @@ import Control.Monad.Trans.Cont
 import Data.Char
 import Data.Int
 import Data.Word
-import Data.Foldable
 import Foreign.Ptr
 import Foreign.C.Types
 import Foreign.Storable
@@ -42,9 +41,12 @@ C.include "<inline-python.h>"
 class ToPy a where
   -- | Convert haskell value to python object. This function returns
   --   strong reference to newly create objects (except singletons
-  --   like @None@, @True@, etc). Normally conversion should not fail
-  --   but when it does function must raise suitable python exception
-  --   and return @NULL@. Caller must check that.
+  --   like @None@, @True@, etc).
+  --
+  --   Implementations should try to avoid failing conversions.
+  --   There're two ways of signalling failure: errors on python side
+  --   should return NULL and raise python exception. Haskell code
+  --   should just throw exception.
   --
   --   This is low level function. It should be only used when working
   --   with python's C API. Otherwise 'toPy' is preferred.
@@ -53,12 +55,15 @@ class ToPy a where
   basicListToPy :: [a] -> Py (Ptr PyObject)
   basicListToPy xs = evalContT $ do
     let n = fromIntegral $ length xs :: CLLong
-    p_list <- liftIO [CU.exp| PyObject* { PyList_New($(long long n)) } |]
+    p_list <- checkNull (Py [CU.exp| PyObject* { PyList_New($(long long n)) } |])
     onExceptionProg $ decref p_list
-    lift $ for_ ([0..] `zip` xs) $ \(i,a) -> do
-      p_a <- basicToPy a
-      Py [CU.exp| void { PyList_SET_ITEM($(PyObject* p_list), $(long long i), $(PyObject* p_a)) } |]
-    pure p_list
+    let loop !_ []     = pure p_list
+        loop  i (a:as) = basicToPy a >>= \case
+          NULL -> pure nullPtr
+          p_a  -> do
+            liftIO [CU.exp| void { PyList_SET_ITEM($(PyObject* p_list), $(long long i), $(PyObject* p_a)) } |]
+            loop (i+1) as
+    lift $ loop 0 xs
 
 -- | Convert python object to haskell value.
 class FromPy a where
@@ -92,8 +97,9 @@ fromPy' py = runPy $ unsafeWithPyObject py basicFromPy
 
 -- | Convert haskell value to a python object.
 toPy :: ToPy a => a -> IO PyObject
-toPy a = runPy $ newPyObject =<< basicToPy a
-
+toPy a = runPy $ basicToPy a >>= \case
+  NULL -> throwPy =<< convertPy2Haskell
+  p    -> newPyObject p
 
 instance ToPy CLong where
   basicToPy i = Py [CU.exp| PyObject* { PyLong_FromLong($(long i)) } |]
@@ -150,15 +156,13 @@ instance FromPy Int where
 instance ToPy Char where
   basicToPy c = do
     let i = fromIntegral (ord c) :: CUInt
-    r <- Py [CU.block| PyObject* {
+    Py [CU.block| PyObject* {
        uint32_t cs[1] = { $(unsigned i) };
        return PyUnicode_DecodeUTF32((char*)cs, 4, NULL, NULL);
        } |]
-    r <$ throwPyError
   basicListToPy str = evalContT $ do
     p_str <- withPyWCString str
-    p     <- liftIO [CU.exp| PyObject* { PyUnicode_FromWideChar($(wchar_t *p_str), -1) } |]
-    lift $ p <$ throwPyError
+    liftIO [CU.exp| PyObject* { PyUnicode_FromWideChar($(wchar_t *p_str), -1) } |]
 
 
 instance FromPy Char where
@@ -196,13 +200,9 @@ instance FromPy Bool where
 
 instance (ToPy a, ToPy b) => ToPy (a,b) where
   basicToPy (a,b) = evalContT $ do
-    p_a <- lift $ basicToPy a
-    onExceptionProg (decref p_a)
-    p_b <- lift $ basicToPy b
-    onExceptionProg (decref p_b)
-    lift $ do
-      r <- Py [CU.exp| PyObject* { PyTuple_Pack(2, $(PyObject* p_a), $(PyObject* p_b)) } |]
-      r <$ throwPyError
+    p_a <- takeOwnership =<< checkNull (basicToPy a)
+    p_b <- takeOwnership =<< checkNull (basicToPy b)
+    liftIO [CU.exp| PyObject* { PyTuple_Pack(2, $(PyObject* p_a), $(PyObject* p_b)) } |]
 
 instance (FromPy a, FromPy b) => FromPy (a,b) where
   basicFromPy p_tup = evalContT $ do
@@ -320,9 +320,14 @@ loadArgFastcall p_arr i tot = do
 -- Helpers
 ----------------------------------------------------------------
 
+-- | Execute haskell callback function
 pyCallback :: Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
 pyCallback io = unPy $ ensureGIL $ evalContT io `catchPy` convertHaskell2Py
 
+-- | Decrement reference counter at end of ContT block
+takeOwnership :: Ptr PyObject -> Program r (Ptr PyObject)
+takeOwnership p = ContT $ \c -> c p `finallyPy` decref p
+
 raiseUndecodedArg :: CInt -> CInt -> Py (Ptr PyObject)
 raiseUndecodedArg n tot = Py [CU.block| PyObject* {
   char err[256];
diff --git a/src/Python/Internal/Program.hs b/src/Python/Internal/Program.hs
index 223db06..ebd845d 100644
--- a/src/Python/Internal/Program.hs
+++ b/src/Python/Internal/Program.hs
@@ -4,6 +4,7 @@ module Python.Internal.Program
     -- * Control flow
   , abort
   , abortM
+  , checkNull
   , finallyProg
   , onExceptionProg
     -- * Allocators
@@ -40,6 +41,12 @@ abort r = ContT $ \_ -> pure r
 abortM :: Monad m => m r -> ContT r m a
 abortM m = ContT $ \_ -> m
 
+-- | If result of computation is NULL return NULL immediately.
+checkNull :: Py (Ptr a) -> Program (Ptr a) (Ptr a)
+checkNull action = ContT $ \cnt -> action >>= \case
+  NULL -> pure nullPtr
+  p    -> cnt p
+
 -- | Evaluate finalizer even if exception is thrown.
 finallyProg
   :: Py b -- ^ Finalizer

From c600000c8442936a9ec2def2c5524e62595bb00b Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 16:57:11 +0300
Subject: [PATCH 04/13] Add more tests

---
 test/TST/Callbacks.hs | 10 +++++++++-
 test/TST/Run.hs       | 21 +++++++++++++++++++++
 2 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/test/TST/Callbacks.hs b/test/TST/Callbacks.hs
index bb0ae50..f2155f0 100644
--- a/test/TST/Callbacks.hs
+++ b/test/TST/Callbacks.hs
@@ -51,11 +51,19 @@ tests = testGroup "Callbacks"
       let foo :: Int -> Int -> IO Int
           foo x y = pure $ x `div` y
       throwsPy [py_| foo_hs(1, 0) |]
-  , testCase "Call python in callback" $ do
+    ----------------------------------------
+  , testCase "Call python in callback (arity=1)" $ do
       let foo :: Int -> IO Int
           foo x = do Just x' <- fromPy =<< [pye| 100 // x_hs |]
                      pure x'
       [py_|
         assert foo_hs(5) == 20
         |]
+  , testCase "Call python in callback (arity=2" $ do
+      let foo :: Int -> Int -> IO Int
+          foo x y = do Just x' <- fromPy =<< [pye| x_hs // y_hs |]
+                       pure x'
+      [py_|
+        assert foo_hs(100,5) == 20
+        |]
   ]
diff --git a/test/TST/Run.hs b/test/TST/Run.hs
index 0ff4d13..b66fc52 100644
--- a/test/TST/Run.hs
+++ b/test/TST/Run.hs
@@ -60,4 +60,25 @@ tests = testGroup "Run python"
         except NameError:
             pass
         |]
+  , testCase "Import py_->any" $ do
+      [py_|
+        import sys
+        sys
+        |]
+      -- Not visible
+      throwsPy $ void [pye| sys |]
+      [py_|
+        try:
+            sys
+            assert False, "sys shouln't be visible (1)"
+        except NameError:
+            pass
+        |]
+      [pymain|
+        try:
+            sys
+            assert False, "sys shouln't be visible (2)"
+        except NameError:
+            pass
+        |]
   ]

From b31c34f578110f28d0c321aae062fb9f9bf4e28d Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 16:59:47 +0300
Subject: [PATCH 05/13] Test that calling wrapped functions doesn't leak

---
 test/TST/Callbacks.hs | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/test/TST/Callbacks.hs b/test/TST/Callbacks.hs
index f2155f0..5e8900c 100644
--- a/test/TST/Callbacks.hs
+++ b/test/TST/Callbacks.hs
@@ -66,4 +66,25 @@ tests = testGroup "Callbacks"
       [py_|
         assert foo_hs(100,5) == 20
         |]
+    ----------------------------------------
+  , testCase "No leaks (arity=1)" $ 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)" $ 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)
+        |]
   ]

From 542d2f5efa49e89a950fd14e68984bcf87b5f77e Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 17:39:20 +0300
Subject: [PATCH 06/13] Rework marshalling of python exceptions to haskell

---
 src/Python/Inline/Literal.hs | 20 ++++----
 src/Python/Internal/Eval.hs  | 88 +++++++++++++++++++-----------------
 src/Python/Internal/Types.hs |  9 ++--
 3 files changed, 61 insertions(+), 56 deletions(-)

diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs
index b447f8b..761cdd7 100644
--- a/src/Python/Inline/Literal.hs
+++ b/src/Python/Inline/Literal.hs
@@ -307,26 +307,22 @@ instance (FromPy a1, FromPy a2, ToPy b) => ToPy (a1 -> a2 -> IO b) where
     -- Create python function
     [C.exp| PyObject* { inline_py_callback_METH_FASTCALL($(PyCFunctionFast f_ptr)) } |]
 
-loadArgFastcall :: FromPy a => Ptr (Ptr PyObject) -> Int -> Int64 -> Program (Ptr PyObject) a
-loadArgFastcall p_arr i tot = do
-  p <- liftIO $ peekElemOff p_arr i
-  lift (tryPy (basicFromPy p)) >>= \case
-    Right a            -> pure a
-    Left  FromPyFailed -> abortM $ raiseUndecodedArg (fromIntegral i + 1) (fromIntegral tot)
-    Left  e            -> lift   $ throwPy e
-
-
 ----------------------------------------------------------------
 -- Helpers
 ----------------------------------------------------------------
 
+
 -- | Execute haskell callback function
 pyCallback :: Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
 pyCallback io = unPy $ ensureGIL $ evalContT io `catchPy` convertHaskell2Py
 
--- | Decrement reference counter at end of ContT block
-takeOwnership :: Ptr PyObject -> Program r (Ptr PyObject)
-takeOwnership p = ContT $ \c -> c p `finallyPy` decref p
+loadArgFastcall :: FromPy a => Ptr (Ptr PyObject) -> Int -> Int64 -> Program (Ptr PyObject) a
+loadArgFastcall p_arr i tot = do
+  p <- liftIO $ peekElemOff p_arr i
+  lift (tryPy (basicFromPy p)) >>= \case
+    Right a            -> pure a
+    Left  FromPyFailed -> abortM $ raiseUndecodedArg (fromIntegral i + 1) (fromIntegral tot)
+    Left  e            -> lift   $ throwPy e
 
 raiseUndecodedArg :: CInt -> CInt -> Py (Ptr PyObject)
 raiseUndecodedArg n tot = Py [CU.block| PyObject* {
diff --git a/src/Python/Internal/Eval.hs b/src/Python/Internal/Eval.hs
index ead9439..983e12f 100644
--- a/src/Python/Internal/Eval.hs
+++ b/src/Python/Internal/Eval.hs
@@ -15,6 +15,7 @@ module Python.Internal.Eval
     -- * PyObject wrapper
   , newPyObject
   , decref
+  , takeOwnership
   , ensureGIL
     -- * Exceptions
   , convertHaskell2Py
@@ -34,7 +35,6 @@ import Foreign.ForeignPtr
 import Foreign.C.Types
 import Foreign.C.String
 import Foreign.Marshal.Array
-import Foreign.Marshal
 import Foreign.Storable
 import System.Environment
 import System.IO.Unsafe
@@ -362,6 +362,10 @@ ensureGIL action = do
   gil_state <- Py [CU.exp| int { PyGILState_Ensure() } |]
   action `finallyPy` Py [CU.exp| void { PyGILState_Release($(int gil_state)) } |]
 
+-- | Decrement reference counter at end of ContT block
+takeOwnership :: Ptr PyObject -> Program r (Ptr PyObject)
+takeOwnership p = ContT $ \c -> c p `finallyPy` decref p
+
 
 -- | Wrap raw python object into
 newPyObject :: Ptr PyObject -> Py PyObject
@@ -399,48 +403,50 @@ convertHaskell2Py err = Py $ do
 --   called if there's unhandled python exception. Clears exception.
 convertPy2Haskell :: Py PyError
 convertPy2Haskell = evalContT $ do
-  p_err <- withPyAlloca @(Ptr CChar)
-  -- Return 0 and set error message if there's python error
-  r     <- liftIO [CU.block| int {
-    char **p_msg = $(char **p_err);
-    PyObject *e_type, *e_value, *e_trace;
-    // Fetch python's error
-    PyErr_Fetch( &e_type, &e_value, &e_trace);
-    if( NULL == e_value ) {
-        return -1;
-    }
-    // Convert to python string object
-    PyObject *e_str = PyObject_Str(e_value);
-    if( NULL == e_str ) {
-        *p_msg = 0;
-        return 0;
-    }
-    // Convert to UTF8 C string
-    Py_ssize_t len;
-    const char *err_msg = PyUnicode_AsUTF8AndSize(e_str, &len);
-    if( 0 == e_str ) {
-        Py_DECREF(e_str);
-        *p_msg = 0;
-        return 0;
-    }
-    // Copy message
-    *p_msg = malloc(len+1);
-    strncpy(*p_msg, err_msg, len);
-    Py_DECREF(e_str);
-    return 0;
-    } |]
-  liftIO $ case r of
-    0 -> peek p_err >>= \case
-      NULL  -> pure $ PyError "CANNOT SHOW EXCEPTION"
-      c_err -> do
-        s <- peekCString c_err
-        free c_err
-        pure $ PyError s
-    _ -> error "No python exception raised"
+  p_errors <- withPyAllocaArray @(Ptr PyObject) 3
+  p_len    <- withPyAlloca      @CLong
+  -- Fetch error indicator
+  (p_type, p_value) <- liftIO $ do
+    [CU.block| void {
+       PyObject **p = $(PyObject** p_errors);
+       PyErr_Fetch(p, p+1, p+2);
+       }|]
+    p_type  <- peekElemOff p_errors 0
+    p_value <- peekElemOff p_errors 1
+    -- Traceback is not used ATM
+    pure (p_type,p_value)
+  -- Convert exception type and value to strings.
+  let pythonStr p = do
+        p_str <- liftIO [CU.block| PyObject* {
+          PyObject *s = PyObject_Str($(PyObject *p));
+          if( PyErr_Occurred() ) {
+              PyErr_Clear();
+          }
+          return s;
+          } |]
+        case p_str of
+          NULL -> abort UncovertablePyError
+          _    -> pure p_str
+  s_type  <- takeOwnership =<< pythonStr p_type
+  s_value <- takeOwnership =<< pythonStr p_value
+  -- Convert to haskell strings
+  let toString p = do
+        c_str <- [CU.block| const char* {
+          const char* s = PyUnicode_AsUTF8AndSize($(PyObject *p), $(long *p_len));
+          if( PyErr_Occurred() ) {
+              PyErr_Clear();
+          }
+          return s;
+          } |]
+        case c_str of
+          NULL -> pure ""
+          _    -> peekCString c_str
+  liftIO $ PyError <$> toString s_type <*> toString s_value
+
 
 -- | Throw python error as haskell exception if it's raised.
 throwPyError :: Py ()
-throwPyError = 
+throwPyError =
   Py [CU.exp| PyObject* { PyErr_Occurred() } |] >>= \case
     NULL -> pure ()
     _    -> throwPy =<< convertPy2Haskell
@@ -456,4 +462,4 @@ throwPyConvesionFailed = do
     } |]
   case r of
     0 -> pure ()
-    _ -> throwPy FromPyFailed 
+    _ -> throwPy FromPyFailed
diff --git a/src/Python/Internal/Types.hs b/src/Python/Internal/Types.hs
index 86d2f6d..06bb82e 100644
--- a/src/Python/Internal/Types.hs
+++ b/src/Python/Internal/Types.hs
@@ -46,10 +46,13 @@ newtype PyObject = PyObject (ForeignPtr PyObject)
 
 -- | Python exception converted to haskell
 data PyError
-  = PyError String
-    -- ^ Python exception
+  = PyError String String
+    -- ^ Python exception. Contains exception type and message as strings.
+  | UncovertablePyError
+    -- ^ Python error could not be converted to haskell for some reason
   | FromPyFailed
-    -- ^ Conversion
+    -- ^ Conversion from python value to failed because python type is
+    --   invalid.
   deriving stock (Show)
 
 instance Exception PyError

From f4a5acee95ac8b0c176dd27238b9570e561c4342 Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 17:52:38 +0300
Subject: [PATCH 07/13] Refactor parsing of arguments

---
 src/Python/Inline/Literal.hs | 48 ++++++++++++++++++++++--------------
 1 file changed, 29 insertions(+), 19 deletions(-)

diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs
index 761cdd7..7c24f72 100644
--- a/src/Python/Inline/Literal.hs
+++ b/src/Python/Inline/Literal.hs
@@ -287,10 +287,7 @@ instance (FromPy a, Show a, ToPy b) => ToPy (a -> IO b) where
   basicToPy f = Py $ do
     -- C function pointer for callback
     f_ptr <- wrapO $ \_ p_a -> pyCallback $ do
-      a <- lift (tryPy (basicFromPy p_a)) >>= \case
-        Left  FromPyFailed -> abortM $ raiseUndecodedArg 1 1
-        Left  e            -> lift   $ throwPy e
-        Right a            -> pure a
+      a <- loadArg p_a 0 1
       liftIO $ unPy . basicToPy =<< f a
     --
     [CU.exp| PyObject* { inline_py_callback_METH_O($(PyCFunction f_ptr)) } |]
@@ -316,26 +313,39 @@ instance (FromPy a1, FromPy a2, ToPy b) => ToPy (a1 -> a2 -> IO b) where
 pyCallback :: Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject)
 pyCallback io = unPy $ ensureGIL $ evalContT io `catchPy` convertHaskell2Py
 
-loadArgFastcall :: FromPy a => Ptr (Ptr PyObject) -> Int -> Int64 -> Program (Ptr PyObject) a
+-- | Load argument from python object for haskell evaluation
+loadArg
+  :: FromPy a
+  => (Ptr PyObject) -- ^ Python object to decode
+  -> Int            -- ^ Argument number (0-based)
+  -> Int64          -- ^ Total number of arguments
+  -> Program (Ptr PyObject) a
+loadArg p (fromIntegral -> i) (fromIntegral -> tot) = ContT $ \success -> do
+  tryPy (basicFromPy p) >>= \case
+    Right a            -> success a
+    Left  FromPyFailed -> Py [CU.block| PyObject* {
+      char err[256];
+      sprintf(err, "Failed to decode function argument %i of %li", $(int i)+1, $(int64_t tot));
+      PyErr_SetString(PyExc_TypeError, err);
+      return NULL;
+      } |]
+    Left  e            -> throwPy e
+
+-- | Load i-th argument from array as haskell parameter
+loadArgFastcall
+  :: FromPy a
+  => Ptr (Ptr PyObject) -- ^ Array of arguments
+  -> Int                -- ^ Argument number (0-based)
+  -> Int64              -- ^ Total number of arguments
+  -> Program (Ptr PyObject) a
 loadArgFastcall p_arr i tot = do
   p <- liftIO $ peekElemOff p_arr i
-  lift (tryPy (basicFromPy p)) >>= \case
-    Right a            -> pure a
-    Left  FromPyFailed -> abortM $ raiseUndecodedArg (fromIntegral i + 1) (fromIntegral tot)
-    Left  e            -> lift   $ throwPy e
-
-raiseUndecodedArg :: CInt -> CInt -> Py (Ptr PyObject)
-raiseUndecodedArg n tot = Py [CU.block| PyObject* {
-  char err[256];
-  sprintf(err, "Failed to decode function argument %i of %i", $(int n), $(int tot));
-  PyErr_SetString(PyExc_TypeError, err);
-  return NULL;
-  } |]
+  loadArg p i tot
 
 raiseBadNArgs :: CInt -> Int64 -> Py (Ptr PyObject)
-raiseBadNArgs tot n = Py [CU.block| PyObject* {
+raiseBadNArgs expected got = Py [CU.block| PyObject* {
   char err[256];
-  sprintf(err, "Function takes exactly %i arguments (%li given)", $(int tot), $(int64_t n));
+  sprintf(err, "Function takes exactly %i arguments (%li given)", $(int expected), $(int64_t got));
   PyErr_SetString(PyExc_TypeError, err);
   return NULL;
   } |]

From 586cba61a63b549ea53021fe8208bcbef18fdaed Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 20:00:11 +0300
Subject: [PATCH 08/13] Simplify handling of threaded RTS

I didn't achieve interrupting python calls and clearly need another approach.
On the flip side this approach is much-much simpler and has 10x less overhead.
---
 src/Python/Internal/Eval.hs  | 238 +++++++++--------------------------
 src/Python/Internal/Types.hs |   1 -
 2 files changed, 59 insertions(+), 180 deletions(-)

diff --git a/src/Python/Internal/Eval.hs b/src/Python/Internal/Eval.hs
index 983e12f..03767f4 100644
--- a/src/Python/Internal/Eval.hs
+++ b/src/Python/Internal/Eval.hs
@@ -26,7 +26,6 @@ module Python.Internal.Eval
 
 import Control.Concurrent
 import Control.Exception
-import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Cont
 import Foreign.Concurrent        qualified as GHC
@@ -37,7 +36,6 @@ import Foreign.C.String
 import Foreign.Marshal.Array
 import Foreign.Storable
 import System.Environment
-import System.IO.Unsafe
 
 import Language.C.Inline          qualified as C
 import Language.C.Inline.Unsafe   qualified as CU
@@ -52,164 +50,81 @@ C.include "<inline-python.h>"
 ----------------------------------------------------------------
 
 -- NOTE: [Python and threading]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
--- Interaction with python interpreter and haskell's threading drives
--- important design decisions:
+-- Python support threading to some extent and it interacts with
+-- haskell threading in interesting and generally unpleasant way.
 --
---  1. Python is essentially single threaded. Before any interaction
---     with interpreter one must acquire GIL.
+--  1. Any thread interacting with python interpreter must hold
+--     global interpreter lock (GIL)
 --
---  2. PyGILState_{Ensure,Release} use thread local state.
+--  2. GIL uses thread local state.
 --
--- With single-threaded RTS this poses no problem. We can call
--- python's C API in any way we like. With multithreaded runtime it
--- turns into big and unwieldy problem. RTS migrates haskell's green
--- threads between OS threads at will. And we can't event acquire GIL
--- since it uses thread-local storage.
+-- This means python must run in bound threads. Or in case of
+-- single-threaded RTS we could just make safe FFI calls. There's only
+-- one thread anyway.
 --
--- So only choice for multithreaded RTS is to create bound thread and
--- perform all python evaluation on it. So we need to separate plain
--- haskell IO and IO which calls C API for that reason we have `Py`
--- monad.
+-- In order to track code with such requirements `Py` monad (just
+-- newtype over `IO`). All code interacting with Python must live in
+-- it. In addition it should run with async exceptions masked since
+-- writing code which works with bare pointers AND safe in presence of
+-- async exceptions is almost impossible.
 --
 --
--- Running `Py` depends on RTS. In single-threaded we treat is plain
--- IO. In multithreaded RTS we create new `PyEvalReq` containing fresh
--- MVars and send it to worker thread. Then we await result from MVar.
---
--- For handling of exceptions see [Threading and exceptions]
---
---
--- Finally last round of problems is GC. We cannot simply call
--- Py_DECREF in any thread. So we have to be build list of Ptrs to be
--- DECREF'ed and worker thread would traverse that list when it gets
--- to it.
+-- And this is not end of our problems with threading. Python
+-- designate thread in which it was initialized as a main thread. It
+-- has special status but if don't take precautions we don't know
+-- which haskell thread it is.
 
 
 
--- NOTE: [Threading and exceptions]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- In case of multithreaded runtime we execute python code on separate
--- thread and thus we have problem of juggling exception between
--- threads. Returning exception thrown by python code is simple:
--- result is returned as `MVar (Either SomeException a)`. Passing
--- exception to python much more complicated.
+-- NOTE: [GC]
+-- ~~~~~~~~~~
 --
--- In single threaded case it's simple: we're in the middle of C call
--- and there's no one else to interrupt computation.
+-- CPython uses reference counting which works very well with
+-- ForeignPtr. But there's a catch decrementing counter is only
+-- possible if one holds GIL. This brings out two problems:
 --
--- In multithreaded case haskell code which communicate with worker
--- thread could be killed by (async) exception. And this means we must
--- interrupt python. Consider following code:
+--  1. Is it OK to run potentially blocking code in finalizer?
 --
--- > [py| while True: pass |]
---
--- Interrupting only haskell means it will continue running blocking
--- python interpreter forever and wasting CPU.
---
--- For each evaluation request we keep it status (EvalStatus). When
--- thread waiting for result of evaluation gets exception it tries to
--- cancel evaluation if it hasn't started yet. If it had started we
--- call `PyErr_SetInterrupt` which is equivalent of sending SIGINT to
--- python.
+--  2. Overhead of `runInBoundThread` is significant for GC (~1μs)
+--     will this cause problem or if there're only few object on
+--     haskell heap it would be fine?
 
 
 
--- NOTE: [Async exceptions]
--- ~~~~~~~~~~~~~~~~~~~~~~~~
+-- NOTE: [Interrupting python]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
--- Code interacting with python interpreter interleaves C calls and
--- haskell code. It's impossible to ensure invariant that python
--- interpreter demands from us if computation could be interrupted in
--- arbitrary points.
+-- Being able to interrupt python when haskell exception arrives is
+-- surely nice. However it's difficult and comes with tradeoffs.
 --
--- So solution is to execute such code with async exceptions masked.
--- `runPy` and friends should ensure that.
+-- First of all call must be done in a separate thread otherwise
+-- there's no one to catch exception and to something. This also means
+-- that python calls made using plain FFI are not interruptible.
 --
--- This may cause problems with callbacks to haskell. Async exceptions
--- won't reach worker thread, and python interpreter couldn't be
--- interrupted as well. We poll for that at beginning of callback.
--- We'll see whether it causes problems in practice.
-
-
-
-----------------------------------------------------------------
--- Data types used for multithreaded RTS
-----------------------------------------------------------------
-
--- | Status of evaluation request for python interprereter
-data EvalStatus
-  = Pending   -- ^ Request has not started evaluation
-  | Running   -- ^ Evaluation is in progress
-  | Cancelled -- ^ Request was cancelled
-  | Done      -- ^ Request finished evaluation
-  deriving stock Show
-
--- | Evaluation request sent to
-data PyEvalReq = forall a. PyEvalReq
-  { prog   :: (Py a)
-  , result :: MVar (Either SomeException a)
-  , status :: MVar EvalStatus
-  }
-
--- | List of pointer. We use it instead of list in order to save on
---   allocations
-data PyObjectList
-  = Nil
-  | Cons !(Ptr PyObject) PyObjectList
-
-
--- Python evaluator reads messages from this MVar
-toPythonThread :: MVar PyEvalReq
-toPythonThread = unsafePerformIO newEmptyMVar
-{-# NOINLINE toPythonThread #-}
-
--- ThreadId of thread running python's interpreter
-pythonInterpreter :: MVar ThreadId
-pythonInterpreter = unsafePerformIO newEmptyMVar
-{-# NOINLINE pythonInterpreter #-}
+-- In addition python's ability to notify other threads are limited:
+--
+--  + `Py_SetInterrupt` plain doesn't work. It uses signal which trips
+--    up haskell RTS as well.
+--
+--  + `PyThreadState_SetAsyncExc` could be use but it requires special
+--    setup from thread being interrupted.
 
--- List of python object waiting for Py_DECREF
-toDECREF :: MVar PyObjectList
-toDECREF = unsafePerformIO $ newMVar Nil
-{-# NOINLINE toDECREF #-}
 
 
 ----------------------------------------------------------------
 -- Execution of Py monad
 ----------------------------------------------------------------
 
--- | Execute python action.
+-- | Execute python action. It will be executed with GIL held and
+--   async exceptions masked.
 runPy :: Py a -> IO a
 -- See NOTE: [Python and threading]
--- See NOTE: [Threading and exceptions]
 runPy py
   -- Multithreaded RTS
-  --
-  -- Here we check whether we're in callback or creating a new call
-  | rtsSupportsBoundThreads = [CU.exp| int { inline_py_callback_depth } |] >>= \case
-      0 -> do
-        result <- newEmptyMVar
-        status <- newMVar Pending
-        let onExc :: SomeException -> IO b
-            onExc e = do
-              modifyMVar_ status $ \case
-                Pending   -> pure Cancelled
-                Cancelled -> pure Cancelled
-                Done      -> pure Done
-                Running   -> Cancelled <$ [CU.exp| void { PyErr_SetInterrupt() } |]
-              throwIO e
-        (do putMVar toPythonThread $ PyEvalReq{ prog=py, ..}
-            takeMVar result >>= \case
-              Left  e -> throwIO e
-              Right a -> pure a
-          ) `catch` onExc
-      _ -> unPy $ ensureGIL py
+  | rtsSupportsBoundThreads = runInBoundThread $ mask_ $ unPy $ ensureGIL py
   -- Single-threaded RTS
-  --
-  -- See NOTE: [Async exceptions]
   | otherwise = mask_ $ unPy $ ensureGIL py
 
 
@@ -227,24 +142,24 @@ unPy (Py io) = io
 -- | Initialize python interpreter. It's safe call this function
 --   multiple times.
 initializePython :: IO ()
-initializePython
-  | rtsSupportsBoundThreads = tryReadMVar pythonInterpreter >>= \case
-      Just _  -> pure ()
-      Nothing -> do
-        pid <- forkOSWithUnmask $ \unmask -> unmask $ do
-          (doInializePython >> forever evalReq) `finally` doFinalizePython
-        putMVar pythonInterpreter pid
-  | otherwise = doInializePython
 -- See NOTE: [Python and threading]
+initializePython
+  | rtsSupportsBoundThreads = runInBoundThread $ mask_ $ do
+      doInializePython
+      -- We need to release GIL. Thread calling this will be
+      -- designated as main will probably never make any progress.
+      -- We'll never restore thread state
+      [CU.exp| void { PyEval_SaveThread() } |]
+  | otherwise = mask_ doInializePython
 
 -- | Destroy python interpreter.
 finalizePython :: IO ()
-finalizePython
-  | rtsSupportsBoundThreads = tryReadMVar pythonInterpreter >>= \case
-      Just pid -> killThread pid
-      Nothing  -> pure ()
-  | otherwise = doFinalizePython
 -- See NOTE: [Python and threading]
+finalizePython
+  | rtsSupportsBoundThreads = runInBoundThread $ do
+      [CU.exp| void { PyGILState_Ensure() } |]
+      mask_ doFinalizePython
+  | otherwise = mask_ doFinalizePython
 
 -- | Bracket which ensures that action is executed with properly
 --   initialized interpreter
@@ -252,7 +167,6 @@ withPython :: IO a -> IO a
 withPython = bracket_ initializePython finalizePython
 
 
-
 doInializePython :: IO ()
 doInializePython = do
   -- NOTE: I'd like more direct access to argv
@@ -312,40 +226,6 @@ doFinalizePython = [C.block| void {
   } |]
 
 
--- Evaluate python code in multithreaded RTS
-evalReq :: IO ()
--- See NOTE: [Python and threading]
--- See NOTE: [Threading and exceptions]
-evalReq = do
-  PyEvalReq{prog, result, status} <- takeMVar toPythonThread
-  -- GC
-  let decrefList Nil = pure ()
-      decrefList (p `Cons` ps) = do [CU.exp| void { Py_XDECREF($(PyObject* p)) } |]
-                                    decrefList ps
-  decrefList =<< modifyMVar toDECREF (\xs -> pure (Nil, xs))
-  -- Update status of request
-  do_eval <- modifyMVar status $ \case
-    Running   -> error "Python evaluator: Internal error. Got 'Running' request"
-    Done      -> error "Python evaluator: Internal error. Got 'Done' request"
-    Cancelled -> return (Cancelled,False)
-    Pending   -> return (Running,  True)
-  when do_eval $ do
-    a <- (Right <$> mask_ (unPy $ ensureGIL prog)) `catches`
-         [ Handler $ \(e :: AsyncException)     -> throwIO e
-         , Handler $ \(e :: SomeAsyncException) -> throwIO e
-         , Handler $ \(e :: SomeException)      -> pure (Left e)
-         ]
-    modifyMVar_ status $ \_ -> pure Done
-    -- It's possible that calling thread raised signal using
-    -- PyErr_SetInterrupt after we finished execution. At this point
-    -- we need to clear signals.
-    --
-    -- FIXME: Is this right way to do this?
-    -- FIXME: Do I need to clear exceptions as well?
-    [CU.exp| void { PyErr_CheckSignals() } |]
-    putMVar result a
-
-
 ----------------------------------------------------------------
 -- Creation of PyObject
 ----------------------------------------------------------------
@@ -370,11 +250,11 @@ takeOwnership p = ContT $ \c -> c p `finallyPy` decref p
 -- | Wrap raw python object into
 newPyObject :: Ptr PyObject -> Py PyObject
 -- We need to use different implementation for different RTS
--- See NOTE: [Python and threading]
+-- See NOTE: [GC]
 newPyObject p
   | rtsSupportsBoundThreads = Py $ do
       fptr <- newForeignPtr_ p
-      GHC.addForeignPtrFinalizer fptr $ modifyMVar_ toDECREF (pure . Cons p)
+      GHC.addForeignPtrFinalizer fptr $ runInBoundThread $ unPy $ decref p
       pure $ PyObject fptr
   | otherwise = Py $ do
       fptr <- newForeignPtr_ p
diff --git a/src/Python/Internal/Types.hs b/src/Python/Internal/Types.hs
index 06bb82e..fd64cca 100644
--- a/src/Python/Internal/Types.hs
+++ b/src/Python/Internal/Types.hs
@@ -68,7 +68,6 @@ instance Exception PyError
 newtype Py a = Py (IO a)
   deriving newtype (Functor,Applicative,Monad,MonadIO,MonadFail)
 -- See NOTE: [Python and threading]
--- See NOTE: [Async exceptions]
 
 catchPy :: forall e a. Exception e => Py a -> (e -> Py a) -> Py a
 catchPy = coerce (catch @e @a)

From e4476a58c02d0a5d39b45faff80a8cc37d2a6758 Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 20:20:20 +0300
Subject: [PATCH 09/13] Add README

---
 README.md | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)
 create mode 100644 README.md

diff --git a/README.md b/README.md
new file mode 100644
index 0000000..2181894
--- /dev/null
+++ b/README.md
@@ -0,0 +1,29 @@
+# inline-python
+
+This is library which embeds python interpreter into haskell programs and allows
+calling python code from haskell and haskell from python seamlessly. This
+project is inspired by [haskell-R](https://tweag.github.io/HaskellR). and tries
+to use similar conventions.
+
+As an example take following program. It captures from environment variables
+with `_hs` suffix. This includes haskell functions.
+
+```haskell
+{-# LANGUAGE QuasiQuotes #-}
+import Python.Inline
+import Python.Inline.QQ
+
+main :: IO ()
+main = withPython $ do
+  let input = [1..10] :: [Int]
+  let square :: Int -> IO Int
+      square x = pure (x * x)
+  print =<< fromPy' @[Int] =<< [pye| [ square_hs(x) for x in input_hs ] |]
+```
+
+it would output:
+
+```
+[1,4,9,16,25,36,49,64,81,100]
+```
+

From bb06a0160528787151503e7f24653798b9712bab Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 20:41:26 +0300
Subject: [PATCH 10/13] Update haddocks

---
 src/Python/Inline.hs         |  9 ++++++---
 src/Python/Inline/Literal.hs | 10 ++++++----
 src/Python/Inline/QQ.hs      | 11 ++++++++++-
 src/Python/Internal/Eval.hs  |  4 ++--
 src/Python/Internal/Types.hs | 19 ++++++++++++-------
 src/Python/Types.hs          | 20 +++++++-------------
 6 files changed, 43 insertions(+), 30 deletions(-)

diff --git a/src/Python/Inline.hs b/src/Python/Inline.hs
index bf59aba..15e7be2 100644
--- a/src/Python/Inline.hs
+++ b/src/Python/Inline.hs
@@ -1,16 +1,19 @@
 -- |
 module Python.Inline
-  ( initializePython
+  ( -- * Interpreter initialization
+    initializePython
   , finalizePython
   , withPython
+    -- * Core data types
   , PyObject
   , PyError(..)
-  , ToPy(..)
-  , FromPy(..)
+    -- * Conversion between haskell and python
   , toPy
   , fromPyEither
   , fromPy
   , fromPy'
+  , ToPy
+  , FromPy
   ) where
 
 
diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs
index 7c24f72..06c2c44 100644
--- a/src/Python/Inline/Literal.hs
+++ b/src/Python/Inline/Literal.hs
@@ -77,21 +77,23 @@ class FromPy a where
   --   with python's C API. Otherwise 'fromPy' is preferred.
   basicFromPy :: Ptr PyObject -> Py a
 
--- | Convert python object to haskell value
+-- | Convert python object to haskell value. All python exceptions
+--   which happen during execution will be converted to @PyError@.
 fromPyEither :: FromPy a => PyObject -> IO (Either PyError a)
 fromPyEither py = runPy $ unsafeWithPyObject py $ \p ->
   (Right <$> basicFromPy p) `catchPy` (pure . Left)
 
 
--- | Convert python object to haskell value. Python exception raised
---   during execution are thrown as exceptions
+-- | Convert python object to haskell value. Will return @Nothing@ if
+--   'FromPyFailed' is thrown. Other python exceptions are rethrown.
 fromPy :: FromPy a => PyObject -> IO (Maybe a)
 fromPy py = runPy $ unsafeWithPyObject py $ \p ->
   (Just <$> basicFromPy p) `catchPy` \case
     FromPyFailed -> pure Nothing
     e            -> throwPy e
 
--- | Convert python object to haskell value. Throws exception on failure
+-- | Convert python object to haskell value. Throws exception on
+--   failure.
 fromPy' :: FromPy a => PyObject -> IO a
 fromPy' py = runPy $ unsafeWithPyObject py basicFromPy
 
diff --git a/src/Python/Inline/QQ.hs b/src/Python/Inline/QQ.hs
index cafff62..fe5ed75 100644
--- a/src/Python/Inline/QQ.hs
+++ b/src/Python/Inline/QQ.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE TemplateHaskell #-}
 -- |
 -- Quasiquoters for embedding python expression into haskell programs.
+-- Python is statement oriented and heavily relies on mutable state.
+-- This means we need several different quasiquoters.
 module Python.Inline.QQ
   ( pymain
   , py_
@@ -16,6 +18,8 @@ import Python.Internal.Eval
 -- | Evaluate python code in context of main module. All variables
 --   defined in this block will remain visible. This quasiquote
 --   doesn't return any python value.
+--
+--   This quote creates object of type @IO ()@
 pymain :: QuasiQuoter
 pymain = QuasiQuoter
   { quoteExp  = \txt -> [| runPy $ do p_main <- basicMainDict
@@ -30,6 +34,8 @@ pymain = QuasiQuoter
 -- | Evaluate python code in context of main module. All variables
 --   defined in this block will be discarded. This quasiquote doesn't
 --   return any python value.
+--
+--   This quote creates object of type @IO ()@
 py_ :: QuasiQuoter
 py_ = QuasiQuoter
   { quoteExp  = \txt -> [| runPy $ do p_globals <- basicMainDict
@@ -44,7 +50,10 @@ py_ = QuasiQuoter
   , quoteDec  = error "quoteDec"
   }
 
--- | Evaluate single python expression
+-- | Evaluate single python expression. It only accepts single
+--   expressions same as python's @eval@.
+--
+--   This quote creates object of type @IO PyObject@
 pye :: QuasiQuoter
 pye = QuasiQuoter
   { quoteExp  = \txt -> [| runPy $ do p_env <- basicNewDict
diff --git a/src/Python/Internal/Eval.hs b/src/Python/Internal/Eval.hs
index 03767f4..21210cc 100644
--- a/src/Python/Internal/Eval.hs
+++ b/src/Python/Internal/Eval.hs
@@ -139,8 +139,8 @@ unPy (Py io) = io
 -- Initialization of interpreter
 ----------------------------------------------------------------
 
--- | Initialize python interpreter. It's safe call this function
---   multiple times.
+-- | Initialize python interpreter. If interpreter is already
+--   initialized it's a noop.
 initializePython :: IO ()
 -- See NOTE: [Python and threading]
 initializePython
diff --git a/src/Python/Internal/Types.hs b/src/Python/Internal/Types.hs
index fd64cca..056f604 100644
--- a/src/Python/Internal/Types.hs
+++ b/src/Python/Internal/Types.hs
@@ -8,6 +8,7 @@
 module Python.Internal.Types
   ( -- * Data type
     PyObject(..)
+  , unsafeWithPyObject
   , PyError(..)
   , Py(..)
   , catchPy
@@ -30,8 +31,9 @@ import Data.Coerce
 import Data.Int
 import Data.Map.Strict           qualified as Map
 import Foreign.Ptr
-import Foreign.ForeignPtr
 import Foreign.C.Types
+import GHC.ForeignPtr
+
 import Language.C.Types
 import Language.C.Inline.Context
 
@@ -44,7 +46,10 @@ import Language.C.Inline.Context
 --   it could only be accessed only in IO monad.
 newtype PyObject = PyObject (ForeignPtr PyObject)
 
--- | Python exception converted to haskell
+unsafeWithPyObject :: forall a. PyObject -> (Ptr PyObject -> Py a) -> Py a
+unsafeWithPyObject = coerce (unsafeWithForeignPtr @PyObject @a)
+
+-- | Python exception converted to haskell.
 data PyError
   = PyError String String
     -- ^ Python exception. Contains exception type and message as strings.
@@ -59,12 +64,12 @@ instance Exception PyError
 
 
 -- | Monad for code which is interacts directly with python
---   interpreter. One could assume that code in this monad executes
---   with async exceptions masked.
+--   interpreter. During its execution python global interpreter lock
+--   (GIL) is held, async exceptions are masked. It's also always
+--   executed on bound thread if RTS supports one.
 --
---   We need to treat code interacting with python interpreter
---   differently from plain @IO@ since it must be executed in single OS
---   threads. On other hand lifting @IO@ to @Py@ is safe.
+--   It's needed in order to distinguish between code that needs such
+--   guarantees and plain IO.
 newtype Py a = Py (IO a)
   deriving newtype (Functor,Applicative,Monad,MonadIO,MonadFail)
 -- See NOTE: [Python and threading]
diff --git a/src/Python/Types.hs b/src/Python/Types.hs
index da1631d..dc35fbb 100644
--- a/src/Python/Types.hs
+++ b/src/Python/Types.hs
@@ -1,20 +1,14 @@
-{-# LANGUAGE CApiFFI           #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE TemplateHaskell   #-}
 -- |
+-- Data types and utilities.
 module Python.Types
-  ( PyObject(..)
-  , PyError(..)
+  ( -- * @Py@ monad
+    Py
+  , runPy
+  , PyObject(..)
   , unsafeWithPyObject
+  , PyError(..)
   ) where
 
-import Data.Coerce
-import Foreign.Ptr
-import GHC.ForeignPtr
 import Python.Internal.Types
-
-unsafeWithPyObject :: forall a. PyObject -> (Ptr PyObject -> Py a) -> Py a
-unsafeWithPyObject = coerce (unsafeWithForeignPtr @PyObject @a)
-
+import Python.Internal.Eval
 

From 47edfe7e97e32c4a7edfea806858a1bbefb81973 Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 20:43:50 +0300
Subject: [PATCH 11/13] Drop unnecessary hack

---
 cbits/python.c          | 6 ------
 include/inline-python.h | 4 ----
 2 files changed, 10 deletions(-)

diff --git a/cbits/python.c b/cbits/python.c
index cdfb76b..8ece0ef 100644
--- a/cbits/python.c
+++ b/cbits/python.c
@@ -11,17 +11,13 @@
 // reacquire GIL there.
 // ================================================================
 
-int inline_py_callback_depth = 0;
-
 static PyObject* callback_METH_O(PyObject* self, PyObject* arg) {
     PyObject    *res;
     PyCFunction *fun = PyCapsule_GetPointer(self, NULL);
     //--
-    inline_py_callback_depth++;
 Py_BEGIN_ALLOW_THREADS
     res = (*fun)(self, arg);
 Py_END_ALLOW_THREADS
-    inline_py_callback_depth--;
     return res;
 }
 
@@ -29,11 +25,9 @@ static PyObject* callback_METH_FASTCALL(PyObject* self, PyObject** args, Py_ssiz
     PyObject        *res;
     PyCFunctionFast *fun = PyCapsule_GetPointer(self, NULL);
     //--
-    inline_py_callback_depth++;
 Py_BEGIN_ALLOW_THREADS
     res = (*fun)(self, args, nargs);
 Py_END_ALLOW_THREADS
-    inline_py_callback_depth--;
     return res;
 }
 
diff --git a/include/inline-python.h b/include/inline-python.h
index b6f0e1c..b9041f8 100644
--- a/include/inline-python.h
+++ b/include/inline-python.h
@@ -23,10 +23,6 @@ typedef _PyCFunctionFast PyCFunctionFast;
 // Callbacks
 // ================================================================
 
-// Callback depth. It's used to decide whether we want to just
-// continue in bound thread. Should only be modified while GIL is held
-extern int inline_py_callback_depth;
-
 // Wrap haskell callback using METH_O calling convention
 PyObject *inline_py_callback_METH_O(PyCFunction fun);
 

From af3b12f9510c6e30f8e5bc42b53fb21b1c16a47d Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 20:51:24 +0300
Subject: [PATCH 12/13] Add From/ToPy for PyObject

---
 src/Python/Inline/Literal.hs | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs
index 06c2c44..e292211 100644
--- a/src/Python/Inline/Literal.hs
+++ b/src/Python/Inline/Literal.hs
@@ -103,6 +103,19 @@ toPy a = runPy $ basicToPy a >>= \case
   NULL -> throwPy =<< convertPy2Haskell
   p    -> newPyObject p
 
+
+----------------------------------------------------------------
+-- Instances
+----------------------------------------------------------------
+
+instance ToPy PyObject where
+  basicToPy o = unsafeWithPyObject o $ \p ->
+    p <$ Py [CU.exp| void { Py_INCREF($(PyObject* p)) } |]
+instance FromPy PyObject where
+  basicFromPy p = do
+    Py [CU.exp| void { Py_INCREF($(PyObject* p)) } |]
+    newPyObject p
+
 instance ToPy CLong where
   basicToPy i = Py [CU.exp| PyObject* { PyLong_FromLong($(long i)) } |]
 instance FromPy CLong where

From 8f185e458e23fb517ccaa6fa945b5b3f9c8fe22c Mon Sep 17 00:00:00 2001
From: Alexey Khudyakov <alexey.skladnoy@gmail.com>
Date: Sat, 4 Jan 2025 21:08:34 +0300
Subject: [PATCH 13/13] Add instances for 3,4 tuples

---
 src/Python/Inline/Literal.hs | 60 ++++++++++++++++++++++++++++++++++--
 test/TST/FromPy.hs           | 23 +++++++++++---
 test/TST/ToPy.hs             |  6 ++++
 3 files changed, 81 insertions(+), 8 deletions(-)

diff --git a/src/Python/Inline/Literal.hs b/src/Python/Inline/Literal.hs
index e292211..000d19e 100644
--- a/src/Python/Inline/Literal.hs
+++ b/src/Python/Inline/Literal.hs
@@ -229,13 +229,67 @@ instance (FromPy a, FromPy b) => FromPy (a,b) where
     lift $ do throwPyError
               when (unpack_ok /= 0) $ throwPy FromPyFailed
     -- Parse each element of tuple
-    p_a <- liftIO $ peekElemOff p_args 0
-    p_b <- liftIO $ peekElemOff p_args 1
-    finallyProg $ decref p_a >> decref p_b
+    p_a <- takeOwnership =<< liftIO (peekElemOff p_args 0)
+    p_b <- takeOwnership =<< liftIO (peekElemOff p_args 1)
     lift $ do a <- basicFromPy p_a
               b <- basicFromPy p_b
               pure (a,b)
 
+instance (ToPy a, ToPy b, ToPy c) => ToPy (a,b,c) where
+  basicToPy (a,b,c) = evalContT $ do
+    p_a <- takeOwnership =<< checkNull (basicToPy a)
+    p_b <- takeOwnership =<< checkNull (basicToPy b)
+    p_c <- takeOwnership =<< checkNull (basicToPy c)
+    liftIO [CU.exp| PyObject* {
+      PyTuple_Pack(3, $(PyObject *p_a), $(PyObject *p_b), $(PyObject *p_c)) } |]
+
+instance (FromPy a, FromPy b, FromPy c) => FromPy (a,b,c) where
+  basicFromPy p_tup = evalContT $ do
+    -- Unpack 3-tuple.
+    p_args    <- withPyAllocaArray 3
+    unpack_ok <- liftIO [CU.exp| int {
+      inline_py_unpack_iterable($(PyObject *p_tup), 3, $(PyObject **p_args))
+      }|]
+    lift $ do throwPyError
+              when (unpack_ok /= 0) $ throwPy FromPyFailed
+    -- Parse each element of tuple
+    p_a <- takeOwnership =<< liftIO (peekElemOff p_args 0)
+    p_b <- takeOwnership =<< liftIO (peekElemOff p_args 1)
+    p_c <- takeOwnership =<< liftIO (peekElemOff p_args 2)
+    lift $ do a <- basicFromPy p_a
+              b <- basicFromPy p_b
+              c <- basicFromPy p_c
+              pure (a,b,c)
+
+instance (ToPy a, ToPy b, ToPy c, ToPy d) => ToPy (a,b,c,d) where
+  basicToPy (a,b,c,d) = evalContT $ do
+    p_a <- takeOwnership =<< checkNull (basicToPy a)
+    p_b <- takeOwnership =<< checkNull (basicToPy b)
+    p_c <- takeOwnership =<< checkNull (basicToPy c)
+    p_d <- takeOwnership =<< checkNull (basicToPy d)
+    liftIO [CU.exp| PyObject* {
+      PyTuple_Pack(4, $(PyObject *p_a), $(PyObject *p_b), $(PyObject *p_c), $(PyObject *p_d)) } |]
+
+instance (FromPy a, FromPy b, FromPy c, FromPy d) => FromPy (a,b,c,d) where
+  basicFromPy p_tup = evalContT $ do
+    -- Unpack 3-tuple.
+    p_args    <- withPyAllocaArray 4
+    unpack_ok <- liftIO [CU.exp| int {
+      inline_py_unpack_iterable($(PyObject *p_tup), 4, $(PyObject **p_args))
+      }|]
+    lift $ do throwPyError
+              when (unpack_ok /= 0) $ throwPy FromPyFailed
+    -- Parse each element of tuple
+    p_a <- takeOwnership =<< liftIO (peekElemOff p_args 0)
+    p_b <- takeOwnership =<< liftIO (peekElemOff p_args 1)
+    p_c <- takeOwnership =<< liftIO (peekElemOff p_args 2)
+    p_d <- takeOwnership =<< liftIO (peekElemOff p_args 3)
+    lift $ do a <- basicFromPy p_a
+              b <- basicFromPy p_b
+              c <- basicFromPy p_c
+              d <- basicFromPy p_d
+              pure (a,b,c,d)
+
 instance (ToPy a) => ToPy [a] where
   basicToPy = basicListToPy
 
diff --git a/test/TST/FromPy.hs b/test/TST/FromPy.hs
index dbc2bdb..ca594c2 100644
--- a/test/TST/FromPy.hs
+++ b/test/TST/FromPy.hs
@@ -46,11 +46,24 @@ tests = testGroup "FromPy"
         [py_| 1+1 |]
     ]
   , testGroup "Tuple2"
-    [ testCase "(2)->2" $ eq @(Int,Bool) (Just (2,True)) =<< [pye| (2,2) |]
-    , testCase "[2]->2" $ eq @(Int,Bool) (Just (2,True)) =<< [pye| [2,2] |]
-    , testCase "(1)->2" $ eq @(Int,Bool) Nothing =<< [pye| (1)     |]
-    , testCase "(3)->2" $ eq @(Int,Bool) Nothing =<< [pye| (1,2,3) |]
-    , testCase "X->2"   $ eq @(Int,Bool) Nothing =<< [pye| 2 |]
+    [ testCase "T2" $ eq @(Int,Bool) (Just (2,True)) =<< [pye| (2,3) |]
+    , testCase "L2" $ eq @(Int,Bool) (Just (2,True)) =<< [pye| [2,3] |]
+    , testCase "L1" $ eq @(Int,Bool) Nothing =<< [pye| [1]     |]
+    , testCase "T3" $ eq @(Int,Bool) Nothing =<< [pye| (1,2,3) |]
+    , testCase "X"  $ eq @(Int,Bool) Nothing =<< [pye| 2 |]
+    ]
+  , testGroup "Tuple3"
+    [ testCase "T3" $ eq @(Int,Int,Int) (Just (1,2,3)) =<< [pye| (1,2,3) |]
+    , testCase "L3" $ eq @(Int,Int,Int) (Just (1,2,3)) =<< [pye| [1,2,3] |]
+    , testCase "L1" $ eq @(Int,Int,Int) Nothing =<< [pye| [1]       |]
+    , testCase "T4" $ eq @(Int,Int,Int) Nothing =<< [pye| (1,2,3,4) |]
+    , testCase "X"  $ eq @(Int,Int,Int) Nothing =<< [pye| 2 |]
+    ]
+  , testGroup "Tuple4"
+    [ testCase "T4" $ eq @(Int,Int,Int,Int) (Just (1,2,3,4)) =<< [pye| (1,2,3,4) |]
+    , testCase "L4" $ eq @(Int,Int,Int,Int) (Just (1,2,3,4)) =<< [pye| [1,2,3,4] |]
+    , testCase "L1" $ eq @(Int,Int,Int,Int) Nothing =<< [pye| [1] |]
+    , testCase "X"  $ eq @(Int,Int,Int,Int) Nothing =<< [pye| 2   |]
     ]
   , testGroup "List"
     [ testCase "()"  $ eq @[Int] (Just [])      =<< [pye| ()      |]
diff --git a/test/TST/ToPy.hs b/test/TST/ToPy.hs
index c19574d..28f8d03 100644
--- a/test/TST/ToPy.hs
+++ b/test/TST/ToPy.hs
@@ -17,6 +17,12 @@ tests = testGroup "ToPy"
   , testCase "Tuple2" $
       let x = (1::Int, 333::Int)
       in [py_| assert x_hs == (1,333) |]
+  , testCase "Tuple3" $
+      let x = (1::Int, 333::Int, True)
+      in [py_| assert x_hs == (1,333,True) |]
+  , testCase "Tuple4" $
+      let x = (1::Int, 333::Int, True, 'c')
+      in [py_| assert x_hs == (1,333,True,'c') |]
   , testCase "nested Tuple2" $
       let x = (1::Int, (333::Int,4.5::Double))
       in [py_| assert x_hs == (1,(333,4.5)) |]