Mask possibly blocking FFI calls safe

src/Python/Inline/Literal.hs

@@ -357,7 +357,7 @@ instance FromPy Integer where
       -1 -> do
         neg <- takeOwnership
            <=< progPy
-             $ throwOnNULL =<< Py [CU.exp| PyObject* { PyNumber_Negative( $(PyObject *p) ) } |]
+             $ throwOnNULL =<< Py [C.exp| PyObject* { PyNumber_Negative( $(PyObject *p) ) } |]
         BA.ByteArray ba <- progIO $ decodePositiveInteger neg
         pure $ GHC.Num.Integer.IN ba
       -- Unreachable
@@ -449,7 +449,7 @@ instance ToPy Bool where
 -- | Uses python's truthiness conventions
 instance FromPy Bool where
   basicFromPy p = do
-    r <- Py [CU.exp| int { PyObject_IsTrue($(PyObject* p)) } |]
+    r <- Py [C.exp| int { PyObject_IsTrue($(PyObject* p)) } |]
     checkThrowPyError
     pure $! r /= 0
 
@@ -465,7 +465,7 @@ instance (FromPy a, FromPy b) => FromPy (a,b) where
   basicFromPy p_tup = runProgram $ do
     -- Unpack 2-tuple.
     p_args    <- withPyAllocaArray 2
-    unpack_ok <- progIO [CU.exp| int {
+    unpack_ok <- progIO [C.exp| int {
       inline_py_unpack_iterable($(PyObject *p_tup), 2, $(PyObject **p_args))
       }|]
     progPy $ do checkThrowPyError
@@ -490,7 +490,7 @@ instance (FromPy a, FromPy b, FromPy c) => FromPy (a,b,c) where
   basicFromPy p_tup = runProgram $ do
     -- Unpack 3-tuple.
     p_args    <- withPyAllocaArray 3
-    unpack_ok <- progIO [CU.exp| int {
+    unpack_ok <- progIO [C.exp| int {
       inline_py_unpack_iterable($(PyObject *p_tup), 3, $(PyObject **p_args))
       }|]
     progPy $ do checkThrowPyError
@@ -518,7 +518,7 @@ instance (FromPy a, FromPy b, FromPy c, FromPy d) => FromPy (a,b,c,d) where
   basicFromPy p_tup = runProgram $ do
     -- Unpack 3-tuple.
     p_args    <- withPyAllocaArray 4
-    unpack_ok <- progIO [CU.exp| int {
+    unpack_ok <- progIO [C.exp| int {
       inline_py_unpack_iterable($(PyObject *p_tup), 4, $(PyObject **p_args))
       }|]
     progPy $ do checkThrowPyError
@@ -558,7 +558,7 @@ instance (ToPy a) => ToPy [a] where
 -- | Will accept any iterable
 instance (FromPy a) => FromPy [a] where
   basicFromPy p_list = do
-    p_iter <- Py [CU.block| PyObject* {
+    p_iter <- Py [C.block| PyObject* {
       PyObject* iter = PyObject_GetIter( $(PyObject *p_list) );
       if( PyErr_Occurred() ) {
           PyErr_Clear();
@@ -604,7 +604,7 @@ instance (ToPy k, ToPy v, Ord k) => ToPy (Map.Map k v) where
             NULL -> mustThrowPyError
             p_k  -> flip finally (decref p_k) $ basicToPy v >>= \case
               NULL -> mustThrowPyError
-              p_v  -> Py [CU.exp| int { PyDict_SetItem($(PyObject *p_dict), $(PyObject* p_k), $(PyObject *p_v)) }|] >>= \case
+              p_v  -> Py [C.exp| int { PyDict_SetItem($(PyObject *p_dict), $(PyObject* p_k), $(PyObject *p_v)) }|] >>= \case
                 0 -> loop xs
                 _ -> nullPtr <$ decref p_v
       loop $ Map.toList dct
@@ -615,7 +615,7 @@ instance (FromPy k, FromPy v, Ord k) => FromPy (Map.Map k v) where
                  throwM BadPyType
     p_iter -> foldPyIterable p_iter
       (\m p -> do k <- basicFromPy p
-                  v <- Py [CU.exp| PyObject* { PyDict_GetItem($(PyObject* p_dct), $(PyObject *p)) }|] >>= \case
+                  v <- Py [C.exp| PyObject* { PyDict_GetItem($(PyObject* p_dct), $(PyObject *p)) }|] >>= \case
                     NULL -> throwM BadPyType
                     p_v  -> basicFromPy p_v
                   pure $! Map.insert k v m)
@@ -671,19 +671,20 @@ foldPyIterable p_iter step a0
 vectorFromPy :: (VG.Vector v a, FromPy a) => Ptr PyObject -> Py (v a)
 {-# INLINE vectorFromPy #-}
 vectorFromPy p_seq = do
-  len <- Py [CU.exp| long long { PySequence_Size($(PyObject* p_seq)) } |]
+  len <- Py [C.exp| long long { PySequence_Size($(PyObject* p_seq)) } |]
   when (len < 0) $ do
     Py [C.exp| void { PyErr_Clear() } |]
     throwM BadPyType
   -- Read data into vector
   buf <- MVG.generateM (fromIntegral len) $ \i -> do
     let i_c = fromIntegral i
-    Py [CU.exp| PyObject* { PySequence_GetItem($(PyObject* p_seq), $(long long i_c)) } |] >>= \case
+    Py [C.exp| PyObject* { PySequence_GetItem($(PyObject* p_seq), $(long long i_c)) } |] >>= \case
       NULL -> mustThrowPyError
       p    -> basicFromPy p `finally` decref p
   VG.unsafeFreeze buf
 
 vectorToPy :: (VG.Vector v a, ToPy a) => v a -> Py (Ptr PyObject)
+{-# INLINE vectorToPy #-}
 vectorToPy vec = runProgram $ do
   p_list <- takeOwnership =<< checkNull (Py [CU.exp| PyObject* { PyList_New($(long long n_c)) } |])
   progPy $ do
@@ -940,7 +941,7 @@ loadArg p (fromIntegral -> i) (fromIntegral -> tot) = Program $ ContT $ \success
     Left  OutOfRange -> oops
     Left  e          -> throwM e
     where
-      oops = Py [CU.block| PyObject* {
+      oops = Py [C.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);
@@ -959,7 +960,7 @@ loadArgFastcall p_arr i tot = do
   loadArg p i tot
 
 raiseBadNArgs :: CInt -> Int64 -> Py (Ptr PyObject)
-raiseBadNArgs expected got = Py [CU.block| PyObject* {
+raiseBadNArgs expected got = Py [C.block| PyObject* {
   char err[256];
   sprintf(err, "Function takes exactly %i arguments (%li given)", $(int expected), $(int64_t got));
   PyErr_SetString(PyExc_TypeError, err);

src/Python/Internal/CAPI.hs

@@ -27,7 +27,7 @@ C.include "<inline-python.h>"
 
 
 decref :: Ptr PyObject -> Py ()
-decref p = Py [CU.exp| void { Py_DECREF($(PyObject* p)) } |]
+decref p = Py [C.exp| void { Py_DECREF($(PyObject* p)) } |]
 
 incref :: Ptr PyObject -> Py ()
 incref p = Py [CU.exp| void { Py_INCREF($(PyObject* p)) } |]
@@ -39,7 +39,7 @@ basicNewSet :: Py (Ptr PyObject)
 basicNewSet = Py [CU.exp| PyObject* { PySet_New(NULL) } |]
 
 basicGetIter :: Ptr PyObject -> Py (Ptr PyObject)
-basicGetIter p = Py [CU.exp| PyObject* { PyObject_GetIter( $(PyObject *p)) } |]
+basicGetIter p = Py [C.exp| PyObject* { PyObject_GetIter( $(PyObject *p)) } |]
 
 basicIterNext :: Ptr PyObject -> Py (Ptr PyObject)
 basicIterNext p = Py [C.exp| PyObject* { PyIter_Next($(PyObject* p)) } |]
@@ -50,7 +50,7 @@ basicCallKwdOnly
   :: Ptr PyObject -- ^ Function object
   -> Ptr PyObject -- ^ Keywords. Must be dictionary
   -> Py (Ptr PyObject)
-basicCallKwdOnly fun kwd = Py [CU.block| PyObject* {
+basicCallKwdOnly fun kwd = Py [C.block| PyObject* {
   PyObject* args = PyTuple_Pack(0);
   PyObject* res  = PyObject_Call($(PyObject *fun), args, $(PyObject *kwd));
   Py_DECREF(args);

src/Python/Internal/Eval.hs

@@ -566,7 +566,7 @@ singleThreadedDecrefCG p = readTVarIO globalPyLock >>= \case
   LockUnlocked    -> gcDecref p
 
 gcDecref :: Ptr PyObject -> IO ()
-gcDecref p = [CU.block| void {
+gcDecref p = [C.block| void {
   PyGILState_STATE st = PyGILState_Ensure();
   Py_XDECREF( $(PyObject* p) );
   PyGILState_Release(st);
@@ -583,7 +583,7 @@ ensureGIL action = do
   -- NOTE: We're cheating here and looking behind the veil.
   --       PyGILState_STATE is defined as enum. Let hope it will stay
   --       this way.
-  gil_state <- Py [CU.exp| int { PyGILState_Ensure() } |]
+  gil_state <- Py [C.exp| int { PyGILState_Ensure() } |]
   action `finally` Py [CU.exp| void { PyGILState_Release($(int gil_state)) } |]
 
 -- | Drop GIL temporarily
@@ -594,7 +594,7 @@ dropGIL action = do
   --       this way.
   st <- Py [CU.exp| PyThreadState* { PyEval_SaveThread() } |]
   Py $ interruptible action
-        `finally` [CU.exp| void { PyEval_RestoreThread($(PyThreadState *st)) } |]
+        `finally` [C.exp| void { PyEval_RestoreThread($(PyThreadState *st)) } |]
 
 
 ----------------------------------------------------------------
@@ -606,7 +606,7 @@ dropGIL action = do
 convertHaskell2Py :: SomeException -> Py (Ptr PyObject)
 convertHaskell2Py err = Py $ do
   withCString ("Haskell exception: "++show err) $ \p_err -> do
-    [CU.block| PyObject* {
+    [C.block| PyObject* {
       PyErr_SetString(PyExc_RuntimeError, $(char *p_err));
       return NULL;
       } |]
@@ -696,7 +696,7 @@ data Main = Main
 
 instance Namespace Main where
   basicNamespaceDict _ =
-    throwOnNULL =<< Py [CU.block| PyObject* {
+    throwOnNULL =<< Py [C.block| PyObject* {
       PyObject* main_module = PyImport_AddModule("__main__");
       if( PyErr_Occurred() )
           return NULL;
@@ -743,7 +743,7 @@ newtype ModulePtr = ModulePtr (Ptr PyObject)
 
 instance Namespace ModulePtr where
   basicNamespaceDict (ModulePtr p) = do
-    throwOnNULL =<< Py [CU.block| PyObject* {
+    throwOnNULL =<< Py [C.block| PyObject* {
       PyObject* dict = PyModule_GetDict($(PyObject* p));
       Py_XINCREF(dict);
       return dict;
@@ -831,7 +831,7 @@ unsafeWithCode (Code bs) = Program $ ContT $ \fun ->
 ----------------------------------------------------------------
 
 debugPrintPy :: Ptr PyObject -> Py ()
-debugPrintPy p = Py [CU.block| void {
+debugPrintPy p = Py [C.block| void {
   PyObject_Print($(PyObject *p), stdout, 0);
   printf(" [REF=%li]\n", Py_REFCNT($(PyObject *p)) );
   } |]

src/Python/Internal/Program.hs

@@ -38,7 +38,7 @@
 import Foreign.Storable
 
 import Language.C.Inline          qualified as C
 import Language.C.Inline.Unsafe   qualified as CU
 
 import Python.Internal.Types
 import Python.Internal.Util
@@ -131,14 +131,14 @@
 --   string. Returns Nothing if exception was raisede
 pyobjectStrAsHask :: Ptr PyObject -> Py (Maybe String)
 pyobjectStrAsHask p_obj = runProgram $ do
-  p_str <- takeOwnership <=< abortOnNull Nothing $ Py [CU.block| PyObject* {
+  p_str <- takeOwnership <=< abortOnNull Nothing $ Py [C.block| PyObject* {
     PyObject *s = PyObject_Str($(PyObject *p_obj));
     if( PyErr_Occurred() ) {
         PyErr_Clear();
     }
     return s;
     } |]
-  c_str <- abortOnNull Nothing $ Py [CU.block| const char* {
+  c_str <- abortOnNull Nothing $ Py [C.block| const char* {
     const char* s = PyUnicode_AsUTF8($(PyObject *p_str));
     if( PyErr_Occurred() ) {
         PyErr_Clear();