diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,33 @@ +0.3.0.0 [2026.10.15] +-------------------- +* Support for asynchronous execution added in module `Python.Inline.Async`. It + uses API modelled after `async` package. Such computations could be + interrupted using `cancelPy` even when they're running python code or haskell + callback/ +* When threaded runtime is used `runPyInMain` could be reliably interrupted by + asynchronous exceptions. +* Python module `inline_python` is now available. It contains exception types + used by library: `AsyncCancelled` and `HaskellError` which wraps haskell + exception from callback. +* `Python.Inline.Monad` and `Python.Inline.Monad.QQ` modules providing monadic + API. It uses `MonadPy` type class which allows user code to carry around + python dictionaries with global and local scopes. +* Package now uses `Custom` build type. It now supports configuring python using + `python3-config` instead of `pkg-config` when `-fpython3-config` manual cabal + flag is set. Default behavior is unchanged. +* Haskell exception raised in haskell callback will be rethrown if not caught by + python instead of being converted to `PyError`. +* `evalPyFunction` is added to company of `eval` and `exec`. It uses new + `PyQuoteFun` data type as parameter. +* `pySource` quasiquoter added. It loads python code from file. +* `createModule` added which gives standard way of defining python code. +* Bug fixes: + - Memory leak in exception handling is fixed. Python exception object were never + freed when exception propagated to haskell side. + - `bindVar` and `codeFromString`, `codeFromText` violated memory safety but + happened to work correctly when strings were created by TH. Consider upgrade + if using them. + 0.2.1.0 [2026.01.13] ---------------- * `From/ToPy` instance for `Integer`&`Natural` added. @@ -21,7 +51,7 @@ 0.1.1 [2025.02.13] ------------------ * Number of deadlocks in `runPyInMain` fixed: - - It no longer deadlocks is exception is thrown + - It no longer deadlocks if 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` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +import Data.Either + +import Distribution.Simple +import Distribution.Simple.Setup +import Distribution.Simple.LocalBuildInfo +import Distribution.PackageDescription +import Distribution.Types.BuildInfo +import Distribution.Types.PackageDescription +import Distribution.Types.CondTree +import Distribution.Types.ForeignLib +import Distribution.Types.UnqualComponentName +import Distribution.Utils.Path +import Distribution.Compat.Lens +import Distribution.Types.BuildInfo.Lens qualified as L + +import Data.List (intercalate, nub) +import System.Process + + +main :: IO () +main = defaultMainWithHooks $ simpleUserHooks + { confHook = patchedConfHook } + + + +patchedConfHook + :: (GenericPackageDescription, HookedBuildInfo) + -> ConfigFlags + -> IO LocalBuildInfo +patchedConfHook (gpd, hbi) flags + | Just True <- lookupFlagAssignment ("python3-config") $ configConfigurationsFlags flags + = do cflags_raw <- readProcess "python3-config" ["--cflags"] "" + ldflags_raw <- readProcess "python3-config" ["--embed", "--ldflags"] "" + -- Split flags + let (inc_dirs,cflags) = partitionEithers + [ case flag of + '-':'I':path -> Left path + _ -> Right flag + | flag <- tokenizeArguments cflags_raw + ] + (ldflags, (libs, lib_dirs)) = fmap partitionEithers $ partitionEithers + [ case flag of + '-':'l':path -> Right (Left path) + '-':'L':path -> Right (Right path) + _ -> Left flag + | flag <- tokenizeArguments ldflags_raw + ] + let tweakLib lib = case lib.libName of + LMainLibName -> lib & L.ccOptions %~ (++ cflags) + & L.includeDirs %~ (++ (toSymb <$> inc_dirs)) + & L.ldOptions %~ (++ ldflags) + & L.extraLibs %~ (++ libs) + & L.extraLibDirs %~ (++ (toSymb <$> lib_dirs)) + _ -> lib + confHook simpleUserHooks + ( gpd { condLibrary = (fmap . fmap) tweakLib (condLibrary gpd) } + , hbi + ) flags + | otherwise = do + confHook simpleUserHooks (gpd, hbi) flags + +tokenizeArguments :: String -> [String] +tokenizeArguments = words + +---------------------------------------------------------------- +-- Compatibility + +#if MIN_VERSION_Cabal_syntax(3,14,0) +toSymb :: String -> SymbolicPathX 'AllowAbsolute from to +toSymb = makeSymbolicPath +#else +toSymb :: String -> String +toSymb = id +#endif diff --git a/cbits/python.c b/cbits/python.c --- a/cbits/python.c +++ b/cbits/python.c @@ -210,3 +210,181 @@ PyLong_AsNativeBytes(p, buf, size, -1); #endif } + + +static Py_tss_t key_py_async = Py_tss_NEEDS_INIT; + +void inline_py_init_state(void *stack) { + int r = PyThread_tss_set(&key_py_async, stack); + if( 0 != r ) { + fprintf(stderr, "inline-python: fatal error: setting thread local storage failed\n"); + exit(1); + } +} + +void inline_py_free_state(void) { + int r = PyThread_tss_set(&key_py_async, NULL); + if( 0 != r ) { + fprintf(stderr, "inline-python: fatal error: setting thread local storage failed\n"); + exit(1); + } +} + +void* inline_py_get_state(void) { + return PyThread_tss_get(&key_py_async); +} + + +void inline_py_initialize(void) { + int r = PyThread_tss_create(&key_py_async); + if( 0 != r ) { + fprintf(stderr, "inline-python: fatal error: Failed to initialized thread local storage\n"); + exit(1); + } +} + +void inline_py_clear_error(void) { + static PyObject* globals = NULL; + static PyObject* locals = NULL; + static PyObject* code = NULL; + if( NULL == code ) { + globals = PyDict_New(); + locals = PyDict_New(); + code = Py_CompileString("None", "", Py_eval_input); + } + // None is immortal. No need to decrement counter + PyEval_EvalCode(code, globals, locals); + PyErr_Clear(); +} + + +// ================================================================ +// inline_python module +// ================================================================ + +PyObject* (*inline_py_haskell_error_repr)(void*); +PyObject* (*inline_py_haskell_error_tyrepr)(void*); + +PyObject* inline_py_AsyncCancelled() { + static PyObject* AsyncCancelled = 0; + if( AsyncCancelled == 0 ) { + AsyncCancelled = PyErr_NewException("inline_python.AsyncCancelled", PyExc_BaseException, 0); + } + return AsyncCancelled; +} + +typedef struct { + PyBaseExceptionObject obj; + void *exception_stableptr; +} HaskellError; + +static void haskell_error_dealloc(PyObject *op) { + HaskellError *self = (HaskellError*) op; + hs_free_stable_ptr(self->exception_stableptr); + Py_TYPE(self)->tp_free(self); +} + +static PyObject* haskell_error_repr(PyObject *op) { + HaskellError *self = (HaskellError*) op; + PyObject* exc_repr = inline_py_haskell_error_repr(self->exception_stableptr); + PyObject* exc_ty = inline_py_haskell_error_tyrepr(self->exception_stableptr); + PyObject* repr = PyUnicode_FromFormat("", exc_ty, exc_repr); + Py_DECREF(exc_repr); + Py_DECREF(exc_ty); + return repr; +} + +static PyTypeObject HaskellError_Type = { + PyVarObject_HEAD_INIT(NULL, 0) + .tp_name = "inline_python.HaskellError", + .tp_basicsize = sizeof(HaskellError), + .tp_flags = Py_TPFLAGS_DEFAULT | Py_TPFLAGS_DISALLOW_INSTANTIATION, + .tp_doc = PyDoc_STR("Wrapper for a haskell exception object"), + .tp_dealloc = haskell_error_dealloc, + .tp_repr = haskell_error_repr +}; + + +PyObject* inline_py_HaskellError() { + static int initialized = 0; + if( 0 == initialized ) { + if( PyType_Ready(&HaskellError_Type) != 0) { + // It should success always and we don't have any reasonable + // way of handing error. + exit(1); + } + initialized = 1; + } + return (PyObject*)&HaskellError_Type; +} + +PyObject* inline_py_HaskellError_create(void* exc_ptr) { + PyTypeObject *base = HaskellError_Type.tp_base; + PyObject *args = PyTuple_New(0); + // Call __new__ + PyObject *obj = base->tp_new(&HaskellError_Type, args, NULL); + if( !obj ) { + goto err; + } + // Call __init__ + if( 0 != base->tp_init(obj, args, NULL) ) { + goto err; + } + // Set custom fields + HaskellError* h_err = (HaskellError*)obj; + h_err->exception_stableptr = exc_ptr; + Py_DECREF(args); + return obj; +err: + Py_DECREF(args); + return NULL; +} + +void* inline_py_HaskellError_get_stableptr(PyObject* err) { + HaskellError *h_err = (HaskellError*) err; + return h_err->exception_stableptr; +} + + + +static PyMethodDef inline_python_methods[] = { + {NULL, NULL, 0, NULL} +}; + +static int inline_python_module_exec(PyObject *m) { + // Initialize module only once + static int initialized = 0; + if( initialized ) { + return 0; + } + initialized = 1; + // + if (PyModule_AddObjectRef(m, "AsyncCancelled", inline_py_AsyncCancelled()) < 0) { + return -1; + } + // + HaskellError_Type.tp_base = (PyTypeObject*)PyExc_Exception; + HaskellError_Type.tp_new = NULL; + if (PyModule_AddObjectRef(m, "HaskellError", inline_py_HaskellError()) < 0) { + return -1; + } + return 0; +} + +static PyModuleDef_Slot inline_python_module_slots[] = { + {Py_mod_exec, inline_python_module_exec}, + {0, NULL} +}; + +static struct PyModuleDef inline_python_module = { + .m_base = PyModuleDef_HEAD_INIT, + .m_name = "inline_python", + .m_size = 0, + .m_slots = inline_python_module_slots, + .m_methods = inline_python_methods, +}; + +PyMODINIT_FUNC PyInit_inline_python(void) +{ + return PyModuleDef_Init(&inline_python_module); +} diff --git a/include/inline-python.h b/include/inline-python.h --- a/include/inline-python.h +++ b/include/inline-python.h @@ -17,6 +17,8 @@ #define Py_IsFinalizing(x) 0 #endif +// General initialization of internal on C side +void inline_py_initialize(void); // ================================================================ @@ -81,3 +83,53 @@ void* buf, size_t size ); + + + +// ================================================================ +// runPyAsync & Async exceptions +// ================================================================ + +// Force clear error possibly raised by PyThreadState_SetAsyncExc +// +// Ordinary PyErr_Clear doesn't work. One needed python interpreter to +// perform somce work in order to see raised exception. +void inline_py_clear_error(void); + +// Initialize thread local storage as used by runPyAsync +void inline_py_init_state(void *stack); + +// Delete thread local storage used by runPyAsync +void inline_py_free_state(void); + +// Return stable pointer to stack from TLS +void* inline_py_get_state(void); + + + +// ================================================================ +// inline_python module +// ================================================================ + +// Function pointers to be set from haskell side + +// String representation of an exception +extern PyObject* (*inline_py_haskell_error_repr)(void*); +// String representation of exception type +extern PyObject* (*inline_py_haskell_error_tyrepr)(void*); + + +PyMODINIT_FUNC PyInit_inline_python(void); + +// Obtain type for async exception. +PyObject* inline_py_AsyncCancelled(); + +// Obtain type for wrapper for haskell exceptions. +PyObject* inline_py_HaskellError(); + +// Create python object wrapping haskell exception +PyObject* inline_py_HaskellError_create(void* exc_ptr); + +// Get StablePtr held by exception. Python object must be of type +// HaskellError +void* inline_py_HaskellError_get_stableptr(PyObject* err); diff --git a/inline-python.cabal b/inline-python.cabal --- a/inline-python.cabal +++ b/inline-python.cabal @@ -1,8 +1,8 @@ Cabal-Version: 3.0 -Build-Type: Simple - +Build-Type: Custom + Name: inline-python -Version: 0.2.1.0 +Version: 0.3.0.0 Synopsis: Python interpreter embedded into haskell. Description: This package embeds python interpreter into haskell program and @@ -24,13 +24,25 @@ py/bound-vars.py Tested-With: - GHC == 9.2.8 GHC == 9.4.8 GHC == 9.6.7 GHC == 9.8.4 GHC == 9.10.2 GHC == 9.12.2 + GHC == 9.14.1 + +custom-setup + setup-depends: base >=4.15 && <5 + , Cabal >=3.0 && <4 + , Cabal-syntax >=3.6 && <4 + , process >=1.6 && <2 + +flag python3-config + Description: Use python3-config instead of pkg-config + Manual: True + Default: False + source-repository head type: git location: http://github.com/Shimuuar/inline-python @@ -55,8 +67,9 @@ ---------------------------------------------------------------- Library import: language - Build-Depends: base >=4.14 && <5 + Build-Depends: base >=4.15 && <5 , primitive >=0.6.2 + , deepseq >=1.4 , vector >=0.13.2 , containers >=0.5 , process @@ -72,13 +85,18 @@ include-dirs: include c-sources: cbits/python.c cc-options: -g -Wall - pkgconfig-depends: python3-embed >= 3.10 + -- Else we use python3-config in Setup.hs + if !flag(python3-config) + pkgconfig-depends: python3-embed >= 3.10 -- Exposed-modules: Python.Inline + Python.Inline.Async + Python.Inline.Eval Python.Inline.Literal + Python.Inline.Monad + Python.Inline.Monad.QQ Python.Inline.QQ - Python.Inline.Eval Python.Inline.Types Other-modules: Python.Internal.CAPI @@ -88,53 +106,53 @@ Python.Internal.Types Python.Internal.Util ----------------------------------------------------------------- -library test - import: language +common tests Default-Extensions: QuasiQuotes + hs-source-dirs: test build-depends: base , inline-python , tasty >=1.2 , tasty-hunit >=0.10 , tasty-quickcheck >=0.10 + , stm , quickcheck-instances >=0.3.33 , exceptions , containers , vector , bytestring , text - hs-source-dirs: test - Exposed-modules: + + +-- Running tests using several threads does very good job at finding threading +-- bugs. Especially deadlocks +test-suite inline-python-tests + import: language, tests + type: exitcode-stdio-1.0 + Ghc-options: -threaded -rtsopts -with-rtsopts=-N2 + main-is: exe/main.hs + Other-modules: TST.Run TST.ToPy TST.FromPy TST.Callbacks TST.Roundtrip TST.Util - --- Running tests using several threads does very good job at finding threading --- bugs. Especially deadlocks -test-suite inline-python-tests - import: language - type: exitcode-stdio-1.0 - Ghc-options: -threaded -with-rtsopts=-N2 - hs-source-dirs: test/exe - main-is: main.hs - build-depends: base - , inline-python - , inline-python:test - , tasty + TST.Module test-suite inline-python-tests1 - import: language + import: language, tests type: exitcode-stdio-1.0 - hs-source-dirs: test/exe - main-is: main.hs - build-depends: base - , inline-python - , inline-python:test - , tasty + Ghc-options: -rtsopts + main-is: exe/main.hs + Other-modules: + TST.Run + TST.ToPy + TST.FromPy + TST.Callbacks + TST.Roundtrip + TST.Util + TST.Module benchmark pysmall import: language diff --git a/src/Python/Inline.hs b/src/Python/Inline.hs --- a/src/Python/Inline.hs +++ b/src/Python/Inline.hs @@ -105,6 +105,7 @@ -- -- Here's list of common problems and solutions and workarounds. -- +-- -- 1. __@inline-python@ cannot find libraries__ -- -- @inline-python@ may look for modules in wrong place. Set @@ -112,9 +113,67 @@ -- right way. -- -- --- 2. __Linker error in GHCi__ +-- 2. __Picking correct python interpreter__ -- +-- Python's version @inline-python@ uses is determined by @libpython3@ +-- it's linked with. This is decided when package is build. Normally +-- @pkg-config@ is used and this means using whatever distribution is +-- shipping. It's also possible to use @python3-config@ program by +-- specifying manual cabal flag @-fpython3-config@. +-- +-- If it's desired that @inline-python@ should use python installed by +-- conda\/uv\/etc @inline-python@ should be built in environment where +-- desired python version is active and use @-fpython3-config@ flag. +-- This could be done by adding following to cabal.project: +-- +-- > constraints: inline-python -fpython3-config +-- +-- +-- 3. __Linker error in GHCi__ +-- -- Attempting to import library using C extensions from ghci may --- result in linker failing to find symbols from @libpython@ like --- @PyFloat_Type@ or some other. Only known workaround is to set --- @LD_PRELOAD=/path/to/libpython3.XX.so@ environment variable. +-- result in linker failing to find symbols from @libpython3@ like +-- @PyFloat_Type@ or some other. There are multiples known +-- workarounds. @libpython3.XX.so@ should be one @inline-python@ was +-- built with. +-- +-- - export @LD_PRELOAD=\/path\/to\/libpython3.XX.so@ environment variable. This +-- works fine most of the time but it will also impact programs called from +-- your repl (e.g. using 'process'). +-- +-- - you can load the relevant symbol only in the current process space using +-- +-- > System.Posix.DynamicLinker.dlopen "/path/to/libpython3.XX.so" [System.Posix.DynamicLinker.RTLD_NOW, System.Posix.DynamicLinker.RTLD_GLOBAL] +-- +-- Note that in ghci, you don't need to explicitly import +-- "System.Posix.DynamicLinker" to run this command. If you use this +-- extensively in your project, it is recommended to add that in your +-- @.ghci@, global or local, either as an unconditionally executed +-- command, or as a macro, such as: +-- +-- > :def setupPythonDLL \_ -> "" <$ System.Posix.DynamicLinker.dlopen "path/to//lib/libpython3.so" [System.Posix.DynamicLinker.RTLD_NOW, System.Posix.DynamicLinker.RTLD_GLOBAL]@ +-- +-- 4. __GHCi reload__ +-- +-- Even if you reload ghci (using @:reload@), the python environment stays +-- initialised. As a result, the python modules imported using 'Python.Inline.QQ.pymain' won't +-- be reloaded, which is often source of confusion. +-- +-- You can use python's @importlib.reload(m)@. For example: +-- +-- > +-- > [pymain| +-- > import json +-- > import importlib +-- > import pandas +-- > import mylib +-- > +-- > # This force reloads mylib +-- > importlib.reload(mylib) +-- > |] +-- +-- +-- Note that there is a performance drawback, the side effects of 'import' are +-- redone and python does not give much guarantee about what is happening here. +-- Use it with caution. We recommend using @importlib.reload@ only during +-- development and not in production. diff --git a/src/Python/Inline/Async.hs b/src/Python/Inline/Async.hs new file mode 100644 --- /dev/null +++ b/src/Python/Inline/Async.hs @@ -0,0 +1,22 @@ +-- | +-- Asynchronous computation using python. Its API is modelled after +-- @async@ package. It evaluates python on separate OS thread so it's +-- more heavyweight than 'Python.Inline.runPy'. But it's possible to +-- properly interrupt running computation with 'cancelPy' or to use +-- 'withPyAsync' to ensure that async computation properly terminated. +-- +-- Since arbitrary IO is available either in @Py@ via @liftIO@ or in +-- haskell callbacks from python code. It's possible to use haskell +-- concurrency primitives to communicate with python thread. +module Python.Inline.Async + ( PyAsync + , PyAsyncCancelled(..) + , runPyAsync + , withPyAsync + , waitPy + , waitPyCatch + , cancelPy + , uninterruptibleCancelPy + ) where + +import Python.Internal.Eval diff --git a/src/Python/Inline/Eval.hs b/src/Python/Inline/Eval.hs --- a/src/Python/Inline/Eval.hs +++ b/src/Python/Inline/Eval.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} -- | -- Interface to python's @eval@ and @exec@ which gives programmer -- control over local and global variables. @@ -7,8 +8,11 @@ ( -- * Python execution eval , exec + , evalPyFunction + , createModule -- * Source code , PyQuote(..) + , PyQuoteFun(..) , Code , codeFromText , codeFromString @@ -22,8 +26,9 @@ , Module(..) ) where -import Data.ByteString.Unsafe qualified as BS +import Data.ByteString qualified as BS import Data.Text (Text) +import Data.Text qualified as T import Data.Text.Encoding qualified as T import Language.C.Inline qualified as C import Language.C.Inline.Unsafe qualified as CU @@ -33,7 +38,6 @@ import Python.Internal.Program import Python.Inline.Literal - ---------------------------------------------------------------- C.context (C.baseCtx <> pyCtx) C.include "" @@ -46,7 +50,7 @@ -> a -- ^ Variable value -> DictBinder bindVar name a = DictBinder $ \p_dict -> runProgram $ do - p_key <- progIOBracket $ BS.unsafeUseAsCString (T.encodeUtf8 name) + p_key <- progIOBracket $ BS.useAsCString (T.encodeUtf8 name) p_obj <- takeOwnership =<< progPy (throwOnNULL =<< basicToPy a) progPy $ do r <- Py [CU.block| int { @@ -56,4 +60,26 @@ case r of 0 -> pure () _ -> mustThrowPyError + + +-- | Create python module from given quote. This function creates new +-- module using @importlib@ machinery and executes quote in context +-- of this module. +createModule + :: Text + -> PyQuote + -> Py Module +createModule name quote = do + -- It would be nice to use quasiquotes but linker chokes on them. + -- We have to this hard way + mdl <- Module <$> evalPyFunction Temp PyQuoteFun + { code = codeFromText $ T.unlines + [ "def _inline_python_(name):" + , " import types" + , " return types.ModuleType(name)" + ] + , binder = bindVar "name" name + } + mdl <$ exec mdl mdl quote + 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 @@ -14,6 +14,8 @@ , fromPy' ) where +import Control.Concurrent +import Control.Concurrent.STM import Control.Exception (evaluate) import Control.Monad import Control.Monad.Catch @@ -44,6 +46,7 @@ import Foreign.Ptr import Foreign.C.Types import Foreign.Storable +import Foreign.StablePtr import Foreign.Marshal.Alloc (alloca,mallocBytes) import Foreign.Marshal.Utils (copyBytes) import GHC.Float (float2Double, double2Float) @@ -357,7 +360,7 @@ -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 +452,7 @@ -- | 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 +468,7 @@ 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 +493,7 @@ 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 +521,7 @@ 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 +561,7 @@ -- | 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 +607,7 @@ 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 +618,7 @@ 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 +674,20 @@ 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 @@ -924,8 +928,28 @@ -- | Execute haskell callback function pyCallback :: Program (Ptr PyObject) (Ptr PyObject) -> IO (Ptr PyObject) -pyCallback io = callbackEnsurePyLock $ unsafeRunPy $ ensureGIL $ runProgram io `catch` convertHaskell2Py +pyCallback io + = mask_ + $ withCallbackStack + $ unsafeRunPy + $ ensureGIL + $ runProgram io `catch` convertHaskell2Py +withCallbackStack :: IO a -> IO a +withCallbackStack = bracket ini fini . const where + ini = [CU.exp| void* { inline_py_get_state() } |] >>= \case + NULL -> return NULL + ptr -> do + tid <- myThreadId + stack <- deRefStablePtr $ castPtrToStablePtr ptr + atomically $ modifyTVar' stack (tid:) + return ptr + fini NULL = return () + fini ptr = do + stack <- deRefStablePtr $ castPtrToStablePtr ptr + atomically $ modifyTVar' stack (drop 1) + + -- | Load argument from python object for haskell evaluation loadArg :: FromPy a @@ -940,7 +964,7 @@ 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 +983,7 @@ 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); diff --git a/src/Python/Inline/Monad.hs b/src/Python/Inline/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Python/Inline/Monad.hs @@ -0,0 +1,76 @@ +-- | +module Python.Inline.Monad + ( -- * Type classes + Namespace(..) + , MonadPy(..) + , evalM + , execM + , evalPyFunctionM + ) where + +import Python.Internal.Eval +import Python.Internal.Types + +-- | Monad which can carry dictionaries or object of global and local +-- python variables around. It's expected that it's some variant of +-- wrapper around 'Py'. +-- +-- For @Py@ global variables are 'Main' and local are 'Temp' +-- +-- @since 0.3 +class Monad m => MonadPy m where + -- | Lift @Py@ computation into given monad. + liftPy :: Py a -> m a + -- | Provide set of global variables. CPS style is used to avoid + -- specifying type of global used by monad (and allow picking it + -- at runtime). + withGlobals + :: (forall globals. Namespace globals => globals -> m a) + -> m a + -- | Same for local variables + withLocals + :: (forall locals. Namespace locals => locals -> m a) + -> m a + +instance MonadPy Py where + liftPy = id + withGlobals f = f Main + withLocals f = f Temp + + +-- | Analog of 'eval' which uses globals and locals carried by 'MonadPy' +-- +-- @since 0.3 +evalM + :: (MonadPy m) + => PyQuote -- ^ Source code + -> m PyObject +evalM q = + withGlobals $ \globals -> + withLocals $ \locals -> + liftPy $ eval globals locals q + +-- | Analog of 'exec' which uses globals and locals carried by +-- 'MonadPy' +-- +-- @since 0.3 +execM + :: (MonadPy m) + => PyQuote -- ^ Source code + -> m () +execM q = + withGlobals $ \globals -> + withLocals $ \locals -> + liftPy $ exec globals locals q + +-- | Analog of 'evalPyFunction' which uses globals and locals carried by +-- 'MonadPy'. +-- +-- @since 0.3 +evalPyFunctionM + :: (MonadPy m) + => PyQuoteFun -- ^ Source code + -> m PyObject +evalPyFunctionM q = + withGlobals $ \globals -> + liftPy $ evalPyFunction globals q diff --git a/src/Python/Inline/Monad/QQ.hs b/src/Python/Inline/Monad/QQ.hs new file mode 100644 --- /dev/null +++ b/src/Python/Inline/Monad/QQ.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE TemplateHaskell #-} +-- | +-- These quasiquotes are analogous to ones defined in +-- "Python.Inline.QQ" but they produce splices which are polymorphic +-- in 'MonadPy'. For 'Py' in particular they behave identically. +module Python.Inline.Monad.QQ + ( -- * Evalution in @Py@ monad + pymain + , py_ + , pye + , pyf + -- * Creation of @PyQuote@ + , pycode + , pyfun + , pySource + ) where + + +import Language.Haskell.TH.Quote + +import Python.Internal.EvalQQ +import Python.Internal.Eval +import Python.Inline.Monad +import Python.Inline.QQ (pycode, pyfun, pySource) + + + +-- | Evaluate sequence of python statements. It uses python's @exec@. +-- Both global and local scope for this quasiquoter are global +-- variables for 'MonadPy' +-- +-- It creates value of type @MonadPy m => m ()@ +pymain :: QuasiQuoter +pymain = QuasiQuoter + { quoteExp = \txt -> [| + withGlobals $ \globals -> + liftPy $ exec globals globals $(expQQ Exec txt) + |] + , quotePat = error "quotePat" + , quoteType = error "quoteType" + , quoteDec = error "quoteDec" + } + +-- | Evaluate sequence of python statements. Global and local +-- variables for this quasiquoter are determined by 'MonadPy' +-- instance. +-- +-- It creates value of type @MonadPy m => m ()@ +py_ :: QuasiQuoter +py_ = QuasiQuoter + { quoteExp = \txt -> [| + withGlobals $ \globals -> + withLocals $ \locals -> + liftPy $ exec globals locals $(expQQ Exec txt) + |] + , quotePat = error "quotePat" + , quoteType = error "quoteType" + , quoteDec = error "quoteDec" + } + +-- | Evaluate single python expression. It only accepts single +-- expressions same as python's @eval@. Its globals are variables +-- are determined by 'MonadPy' instance. +-- +-- This quote creates object of type @MonadPy m => m PyObject@ +pye :: QuasiQuoter +pye = QuasiQuoter + { quoteExp = \txt -> [| + withGlobals $ \globals -> + withLocals $ \locals -> + liftPy $ eval globals locals $(expQQ Eval txt) + |] + , quotePat = error "quotePat" + , quoteType = error "quoteType" + , quoteDec = error "quoteDec" + } + +-- | Another quasiquoter which works around that sequence of python +-- statements doesn't have any value associated with it. Content of +-- quasiquote is function body. So to get value out of it one must +-- call return. Its globals are determined by 'MonadPy' instance. +-- Just like python function it always creates new scope. +-- +-- This quote creates object of type @Py PyObject@ +pyf :: QuasiQuoter +pyf = QuasiQuoter + { quoteExp = \txt -> [| + withGlobals $ \globals -> + liftPy $ evalPyFunction globals $(expQQ Fun txt) + |] + , quotePat = error "quotePat" + , quoteType = error "quoteType" + , quoteDec = error "quoteDec" + } diff --git a/src/Python/Inline/QQ.hs b/src/Python/Inline/QQ.hs --- a/src/Python/Inline/QQ.hs +++ b/src/Python/Inline/QQ.hs @@ -30,25 +30,38 @@ -- > do_that() -- > |] -- --- If control over python's global and local variables is --- required. APIs from "Python.Inline.Eval" should be used instead. +-- +-- == Variable scope +-- +-- Python has two copes: global and local variables. Both are simply +-- @dict[str,Any]@. Quasiquoters use different dictionaries for +-- globals and locals. If tighter control over variables scope is +-- required APIs from "Python.Inline.Eval" should be used instead. module Python.Inline.QQ - ( pymain + ( -- * Evalution in @Py@ monad + pymain , py_ , pye , pyf + -- * Creation of @PyQuote@ + -- $PyQuote , pycode + , pyfun + , pySource ) where import Language.Haskell.TH.Quote +import Language.Haskell.TH.Syntax qualified as TH import Python.Internal.EvalQQ import Python.Internal.Eval +import Python.Internal.Types --- | Evaluate sequence of python statements. It works in the same way --- as python's @exec@. All module imports and all variables defined --- in this quasiquote will be visible to later quotes. +-- | Evaluate sequence of python statements. It uses python's @exec@. +-- Both global and local scope for this quasiquoter are variables of +-- @\__main__@ module. Any variables including imported modules will +-- remain visible to later quasiquotes. -- -- It creates value of type @Py ()@ pymain :: QuasiQuoter @@ -59,9 +72,11 @@ , quoteDec = error "quoteDec" } --- | Evaluate sequence of python statements. All module imports and --- all variables defined in this quasiquote will be discarded and --- won't be visible in later quotes. +-- | Evaluate sequence of python statements. Global variables for this +-- quasiquoter are one defined in @\__main__@ module and locals use +-- newly allocated dictionary. It will be discarded after execution +-- so variables defined in this quasiquote are visible only inside +-- of it. -- -- It creates value of type @Py ()@ py_ :: QuasiQuoter @@ -73,7 +88,8 @@ } -- | Evaluate single python expression. It only accepts single --- expressions same as python's @eval@. +-- expressions same as python's @eval@. Its globals are variables in +-- @\__main__@ module and locals are new dictionary same as in @py_@. -- -- This quote creates object of type @Py PyObject@ pye :: QuasiQuoter @@ -85,21 +101,30 @@ } -- | Another quasiquoter which works around that sequence of python --- statements doesn't have any value associated with it. Content of +-- statements doesn't have any value associated with it. Content of -- quasiquote is function body. So to get value out of it one must --- call return +-- call return. Its globals are variables in @\__main__@ module and +-- locals are new dictionary same as in @py_@. +-- +-- This quote creates object of type @Py PyObject@ pyf :: QuasiQuoter pyf = QuasiQuoter - { quoteExp = \txt -> [| evaluatorPyf $(expQQ Fun txt) |] + { quoteExp = \txt -> [| evalPyFunction Main $(expQQ Fun txt) |] , quotePat = error "quotePat" , quoteType = error "quoteType" , quoteDec = error "quoteDec" } --- | Create quote of python code suitable for use with --- 'Python.Inline.Eval.exec' +-- $PyQuote -- --- It creates value of type @PyQuote@ +-- 'PyQuote' wraps python code and bould haskell variables. It could +-- be evaluated using 'Python.Inline.Eval.exec', +-- 'Python.Inline.Eval.eval', 'Python.Inline.Eval.evalPyFunction'. + + +-- | Create quote of python code. It captures haskell variables in the +-- same way as rest of quasiquotes and creates value of type +-- 'Python.Inline.Eval.PyQuote'. -- -- @since 0.2@ pycode :: QuasiQuoter @@ -109,3 +134,30 @@ , quoteType = error "quoteType" , quoteDec = error "quoteDec" } + +-- | Create quote of python code suitable for use with +-- 'Python.Inline.Eval.exec' +-- +-- It creates value of type @PyQuoteFun@ +-- +-- @since 0.3@ +pyfun :: QuasiQuoter +pyfun = QuasiQuoter + { quoteExp = \txt -> expQQ Fun txt + , quotePat = error "quotePat" + , quoteType = error "quoteType" + , quoteDec = error "quoteDec" + } + +-- | Create value of type 'PyQuote' from file. Created quote doesn't +-- capture any variables. +-- +-- @since 0.3 +pySource :: FilePath -> TH.Q TH.Exp +pySource path = do + TH.addDependentFile path + [| PyQuote + ($(TH.lift =<< TH.runIO (codeFromString <$> readFile path))) + mempty + |] + diff --git a/src/Python/Internal/CAPI.hs b/src/Python/Internal/CAPI.hs --- a/src/Python/Internal/CAPI.hs +++ b/src/Python/Internal/CAPI.hs @@ -4,6 +4,7 @@ -- Thin wrappers over C API module Python.Internal.CAPI ( decref + , xdecref , incref -- * Simple wrappers , basicNewDict @@ -27,8 +28,11 @@ decref :: Ptr PyObject -> Py () -decref p = Py [CU.exp| void { Py_DECREF($(PyObject* p)) } |] +decref p = Py [C.exp| void { Py_DECREF($(PyObject* p)) } |] +xdecref :: Ptr PyObject -> Py () +xdecref p = Py [C.exp| void { Py_XDECREF($(PyObject* p)) } |] + incref :: Ptr PyObject -> Py () incref p = Py [CU.exp| void { Py_INCREF($(PyObject* p)) } |] @@ -39,7 +43,7 @@ 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 +54,7 @@ :: 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); 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 @@ -2,12 +2,12 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- | -- Evaluation of python expressions. module Python.Internal.Eval ( -- * Locks ensurePyLock - , callbackEnsurePyLock -- * Initialization , initializePython , finalizePython @@ -16,6 +16,15 @@ , runPy , runPyInMain , unsafeRunPy + -- ** Async + , PyAsync + , PyAsyncCancelled(..) + , waitPy + , waitPyCatch + , cancelPy + , uninterruptibleCancelPy + , runPyAsync + , withPyAsync -- * GC-related , newPyObject -- * C-API wrappers @@ -40,13 +49,15 @@ , unsafeWithCode , eval , exec + , evalPyFunction -- * Debugging , debugPrintPy ) where import Control.Concurrent import Control.Concurrent.STM -import Control.Exception (interruptible) +import Control.Exception (interruptible,evaluate) +import Control.DeepSeq import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class @@ -54,11 +65,12 @@ import Data.Maybe import Data.Function import Data.ByteString.Unsafe qualified as BS +import Data.Typeable import Foreign.Concurrent qualified as GHC import Foreign.Ptr import Foreign.ForeignPtr +import Foreign.StablePtr import Foreign.C.Types -import Foreign.C.String import Foreign.Marshal.Array import Foreign.Storable import System.Environment @@ -96,37 +108,43 @@ -- Haskell has two runtimes. Single threaded one doesn't cause any -- troubles and won't be discussed further. Multithreaded one -- implement N-M threading and schedules N green thread on M OS --- threads as it see fit. --- --- One could think that running python code in bound threads and --- making sure that GIL is held would suffice. It doesn't. Doing so --- would quickly results in deadlock. Exact reason for that is not --- understood. --- --- Another problem is GHC may schedule two threads each running python --- code on same capability. They won't have any problems taking GIL --- and will run concurrently stepping on each other's toes. +-- threads as GHC RTS sees fit. -- --- Only way to solve this problem is to introduce another lock on --- haskell side. It's visible to haskell RTS so we won't get deadlocks --- and it makes sure that only one haskell thread interacts with --- python at a time. +-- Runtime may migrate haskell threads between OS threads freely so +-- consecutive calls to python may happen in different threads. This +-- doesn't seem to cause problems so far. In similar way several +-- threads may interleave calls to python in single OS +-- thread. Hopefully it won't cause problems either. -- +-- Pre 0.3 version had a global lock allowing only single runPy to +-- execute at any time. -- +-- For uses where serious concurrency is required runPyAsync machinery +-- should be used. See NOTE [Py Async] for details. + + + +-- NOTE: [Main thread] +-- ~~~~~~~~~~~~~~~~~~~ -- -- Also python designate thread in which python interpreter was -- initialized as a main thread. It has special status for example --- some libraries may run only in main thread (e.g. tkinter). But if --- we don't take special precautions we won't know which thread it --- is. --- +-- some libraries may run only in main thread (e.g. tkinter). In +-- single threaded runtime everything is simple: we one only one +-- thread anyway. -- +-- In multithreaded one we start dedicated thread using forkOS and use +-- standard tools for interacting with it. This requires asynchrony +-- and all complications that come with it. -- --- There's of course question how well python threading interacts with --- haskell. No one knows, probably it won't work well. +-- Execution is protected by haskell mutex. Only one thread can +-- evaluate code at time. This is critical for preserving correctness +-- for cancelling main thread. While we hold lock no one else can +-- perform operations with main thread. + -- NOTE: [GC] -- ~~~~~~~~~~ -- @@ -149,23 +167,49 @@ -- NOTE: [Interrupting python] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- --- Being able to interrupt python when haskell exception arrives is --- surely nice. However it's difficult and comes with tradeoffs. +-- Interrupting program that mixes python and haskell code is in fact +-- very difficult. -- --- 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. +-- + Haskell code cannot receive exceptions while in foreign call. -- --- In addition python's ability to notify other threads are limited: +-- + Haskell callback from python created new lightweight +-- thread. Thus we cannot interrupt callback thread since we need +-- to know its thread ID. -- -- + `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. +-- + `PyThreadState_SetAsyncExc` uses OS thread id (or something +-- similar) as a key. So we must execute code in a bound thread and +-- be sure that no other haskell thread (except callbacks) uses it. +-- +-- Together this means it's only possible to interrupt python when +-- it's called in dedicated OS thread. Such as created by `runPyAsync` +-- or in main thread. To do this we need thread ID as used by python. +-- +-- To interrupt haskell, whether thread we spawned or any callback +-- we'll have to maintain stack of thread IDs somehow. Obvoiusly +-- such stack has to be done by callback. +-- +-- And even if we do have stack we can't reliably interrupt callbacks +-- due to asynchrony. We may look at stack just before callbacks TID +-- is pushed onto it. In that case we'll try interrupt parent +-- thread. Or we can use its value just before TID is popped. In that +-- case we'll interrupt thread that's about to stop or stopped +-- already. +-- +-- So it seems only way of dealing with this problem is to try to kill +-- thread on top of stack and whenever new thread appear on top of +-- stack. +-- +-- +-- As for runPy it seems there's simply no way to forcefully interrupt +-- computation. So it's not interruptible. + + ---------------------------------------------------------------- -- Lock and global state ---------------------------------------------------------------- @@ -184,15 +228,17 @@ = NotInitialized -- ^ Initialization is not done. Initial state. | InInitialization - -- ^ Interpreter is being initialized. + -- ^ Interpreter is being initialized. This state is required in + -- case initialization is started from different threads. | InitFailed -- ^ Initialization was attempted but failed for whatever reason. | Running1 -- ^ Interpreter is running. We're using single threaded RTS | RunningN !(Chan (Ptr PyObject)) !(MVar EvalReq) - !ThreadId - !ThreadId + !ThreadId -- Haskell ID of main thread + !PyThreadId -- Python ID of main thread + !ThreadId -- GC thread ID -- ^ Interpreter is running. We're using multithreaded RTS | InFinalization -- ^ Interpreter is being finalized. @@ -211,68 +257,39 @@ data PyLock = LockUninialized -- ^ There's no interpreter and lock does not exist. - | LockUnlocked - -- ^ Lock could be taked - | Locked !ThreadId [ThreadId] - -- ^ Python is locked by given thread. Lock could be taken multiple - -- times - | LockedByGC - -- ^ Python is locked by GC thread. + | LockReady !(TVar Int) !(TMVar ()) + -- ^ Interpreter is properly initialized and we track number of + -- threads running python. Same thread may take lock multiple + -- times: e.g. nested runPy. + -- + -- Second parameter is mutex for main. We allow only single + -- request in flight. | LockFinalized -- ^ Python interpreter shut down. Taking lock is not possible - deriving Show -- | Execute code ensuring that python lock is held by current thread. ensurePyLock :: IO a -> IO a -ensurePyLock action = do - tid <- myThreadId - bracket_ (atomically $ acquireLock tid) - (atomically $ releaseLock tid) - action - --- | Retake lock regardless of thread which hold lock. Lock must be --- already taken. Caller must make sure that thread holding lock is --- block for duration of action. --- --- This is very unsafe. It must be used only in callbacks from --- python to haskell -callbackEnsurePyLock :: IO a -> IO a -callbackEnsurePyLock action = do - tid <- myThreadId - bracket_ (atomically $ grabLock tid) - (atomically $ releaseLock tid) - action - +ensurePyLock = bracket_ + (atomically acquireLock) + (atomically releaseLock) -acquireLock :: ThreadId -> STM () -acquireLock tid = readTVar globalPyLock >>= \case +acquireLock :: STM () +acquireLock = readTVar globalPyLock >>= \case LockUninialized -> throwSTM PythonNotInitialized LockFinalized -> throwSTM PythonIsFinalized - LockedByGC -> retry - LockUnlocked -> writeTVar globalPyLock $ Locked tid [] - Locked t xs - | t == tid -> writeTVar globalPyLock $ Locked t (t : xs) - | otherwise -> retry + LockReady n _ -> modifyTVar' n succ -grabLock :: ThreadId -> STM () -grabLock tid = readTVar globalPyLock >>= \case +releaseLock :: STM () +releaseLock = readTVar globalPyLock >>= \case LockUninialized -> throwSTM PythonNotInitialized LockFinalized -> throwSTM PythonIsFinalized - LockedByGC -> retry - LockUnlocked -> writeTVar globalPyLock $ Locked tid [] - Locked t xs -> writeTVar globalPyLock $ Locked tid (t : xs) + LockReady n _ -> modifyTVar' n pred -releaseLock :: ThreadId -> STM () -releaseLock tid = readTVar globalPyLock >>= \case - LockUninialized -> throwSTM PythonNotInitialized - LockFinalized -> throwSTM PythonIsFinalized - LockUnlocked -> throwSTM $ PyInternalError "releaseLock: releasing LockUnlocked" - LockedByGC -> throwSTM $ PyInternalError "releaseLock: releasing LockedByGC" - Locked t xs - | t /= tid -> throwSTM $ PyInternalError "releaseLock: releasing wrong lock" - | otherwise -> writeTVar globalPyLock $! case xs of - [] -> LockUnlocked - t':ts -> Locked t' ts +ensureInit :: IO () +ensureInit = readTVarIO globalPyLock >>= \case + LockUninialized -> throwM PythonNotInitialized + LockFinalized -> throwM PythonIsFinalized + LockReady{} -> pure () @@ -286,8 +303,8 @@ initializePython :: IO () -- See NOTE: [Python and threading] initializePython = [CU.exp| int { Py_IsInitialized() } |] >>= \case - 0 | rtsSupportsBoundThreads -> runInBoundThread $ doInializePython - | otherwise -> doInializePython + 0 | rtsSupportsBoundThreads -> runInBoundThread $ doInitializePython + | otherwise -> doInitializePython _ -> pure () -- | Destroy python interpreter. @@ -304,7 +321,7 @@ Py_Finalize(); } |] -- We need to call Py_Finalize on main thread - RunningN _ lock_eval _ tid_gc -> checkLock $ do + RunningN _ lock_eval _ _ tid_gc -> checkLock $ do killThread tid_gc resp <- newEmptyMVar putMVar lock_eval $ StopReq resp @@ -313,12 +330,11 @@ 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 + LockReady n _ -> readTVar n >>= \case + 0 -> do writeTVar globalPyLock LockFinalized + writeTVar globalPyState Finalized + pure action + _ -> retry -- | Bracket which ensures that action is executed with properly -- initialized interpreter @@ -326,8 +342,8 @@ withPython = bracket_ initializePython finalizePython -doInializePython :: IO () -doInializePython = do +doInitializePython :: IO () +doInitializePython = do -- First we need to grab global python lock on haskell side join $ atomically $ do readTVar globalPyState >>= \case @@ -340,8 +356,10 @@ NotInitialized -> do writeTVar globalPyState InInitialization let fini st = atomically $ do + n <- newTVar 0 + main_lock <- newTMVar () writeTVar globalPyState $ st - writeTVar globalPyLock $ LockUnlocked + writeTVar globalPyLock $ LockReady n main_lock pure $ (mask_ $ if -- On multithreaded runtime create bound thread to make @@ -351,56 +369,69 @@ lock_eval <- newEmptyMVar -- Main thread tid_main <- forkOS $ mainThread lock_init lock_eval - takeMVar lock_init >>= \case - True -> pure () - False -> throwM PyInitializationFailed + tid_py <- takeMVar lock_init >>= \case + Just tid -> pure tid + Nothing -> throwM PyInitializationFailed -- GC thread gc_chan <- newChan tid_gc <- forkOS $ gcThread gc_chan - fini $ RunningN gc_chan lock_eval tid_main tid_gc + fini $ RunningN gc_chan lock_eval tid_main tid_py tid_gc -- Nothing special is needed on single threaded RTS | otherwise -> do - doInializePythonIO >>= \case + doInitializePythonIO >>= \case True -> pure () False -> throwM PyInitializationFailed fini Running1 ) `onException` atomically (writeTVar globalPyState InitFailed) -- This action is executed on python's main thread -mainThread :: MVar Bool -> MVar EvalReq -> IO () +mainThread :: MVar (Maybe PyThreadId) -> MVar EvalReq -> IO () mainThread lock_init lock_eval = do - r_init <- doInializePythonIO - putMVar lock_init r_init - case r_init of - False -> pure () - True -> mask_ $ fix $ \loop -> - (takeMVar lock_eval `catch` (\InterruptMain -> pure HereWeGoAgain)) >>= \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 () - HereWeGoAgain -> loop + doInitializePythonIO >>= \case + False -> putMVar lock_init Nothing + True -> do + putMVar lock_init . Just =<< getPyThreadID + mask_ $ fix $ \loop -> do + -- Here we discard any late PyAsyncCancelled exceptions + (takeMVar lock_eval `catch` (\PyAsyncCancelled -> pure HereWeGoAgain)) >>= \case + EvalReq py resp alive tid_stack -> do + let action = withAsyncInitTLS tid_stack $ unsafeRunPy $ ensureGIL $ do + -- We must clear any error python indication. It + -- could be leftover from interrupting previous + -- evaluation + Py $ [CU.exp| void { inline_py_clear_error() } |] + Py $ putMVar alive True + py + res <- try action + `finally` uninterruptibleMask_ (modifyMVar_ alive (\_ -> pure False)) + putMVar resp res + loop + StopReq resp -> do + [C.block| void { + PyGILState_Ensure(); + inline_py_clear_error(); + Py_Finalize(); + } |] + putMVar resp () + HereWeGoAgain -> loop -doInializePythonIO :: IO Bool -doInializePythonIO = do +doInitializePythonIO :: IO Bool +doInitializePythonIO = do -- FIXME: I'd like more direct access to argv argv0 <- getProgName argv <- getArgs let n_argv = fromIntegral $ length argv + 1 - -- FIXME: For some reason sys.argv is initialized incorrectly. No - -- easy way to debug. Will do for now + hask_err_repr <- wrapReprFromStablePtr haskellErrorRepr + hask_err_tyrepr <- wrapReprFromStablePtr haskellErrorTyRepr r <- evalContT $ do p_argv0 <- ContT $ withWCString argv0 p_argv <- traverse (ContT . withWCString) argv ptr_argv <- ContT $ withArray (p_argv0 : p_argv) liftIO [C.block| int { + // Set global constants + inline_py_haskell_error_repr = $(PyObject* (*hask_err_repr)(void*)); + inline_py_haskell_error_tyrepr = $(PyObject* (*hask_err_tyrepr)(void*)); // Now fill config PyStatus status; PyConfig cfg; @@ -420,12 +451,31 @@ if( PyStatus_Exception(status) ) { goto error; }; + // Make builting module visible to python + PyImport_AppendInittab("inline_python", PyInit_inline_python); // Initialize interpreter status = Py_InitializeFromConfig(&cfg); if( PyStatus_Exception(status) ) { goto error; }; PyConfig_Clear(&cfg); + // This is hack for python<=3.11. + // + // Somehow we may end up in stet where thread ID of main thread is not equal + // to main thread's one. Importing threading seems to fix it. However exact + // reason for such behavior is unknown + if( PY_MINOR_VERSION <= 11 ) { + PyObject *threading = PyImport_ImportModule("threading"); + if( PyErr_Occurred() ) { + PyErr_Clear(); + } + } + // Initialize internals. We also need to import module with our internals + inline_py_initialize(); + PyObject *inline_python = PyImport_ImportModule("inline_python"); + if( PyErr_Occurred() ) { + PyErr_Clear(); + } // Release GIL so other threads may take it PyEval_SaveThread(); return 0; @@ -436,23 +486,54 @@ } |] return $! r == 0 +haskellErrorRepr :: Ptr () -> IO (Ptr PyObject) +haskellErrorRepr ptr = unsafeRunPy $ runProgram $ do + SomeException err <- progIO $ deRefStablePtr $ castPtrToStablePtr ptr + -- We need to make sure that we evaluated string so that we won't + -- leak exceptions + repr <- progIO $ evaluate $ force $ show err + p_str <- withPyWCString repr + progIO [CU.exp| PyObject* { PyUnicode_FromWideChar($(wchar_t *p_str), -1) } |] +haskellErrorTyRepr :: Ptr () -> IO (Ptr PyObject) +haskellErrorTyRepr ptr = unsafeRunPy $ runProgram $ do + SomeException err <- progIO $ deRefStablePtr $ castPtrToStablePtr ptr + -- We need to make sure that we evaluated string so that we won't + -- leak exceptions + repr <- progIO $ evaluate $ force $ show $ typeOf err + p_str <- withPyWCString repr + progIO [CU.exp| PyObject* { PyUnicode_FromWideChar($(wchar_t *p_str), -1) } |] + +type FunWrapper a = a -> IO (FunPtr a) + +foreign import ccall "wrapper" wrapReprFromStablePtr + :: FunWrapper (Ptr () -> IO (Ptr PyObject)) + + + ---------------------------------------------------------------- -- Running Py monad ---------------------------------------------------------------- +-- | Request that we send to main thread data EvalReq - = forall a. EvalReq (Py a) (MVar (Either SomeException a)) + = forall a. EvalReq (Py a) (MVar (Either SomeException a)) (MVar Bool) (TVar [ThreadId]) + -- ^ Request to run code in main thread | StopReq (MVar ()) + -- ^ Stop evaluation | HereWeGoAgain + -- ^ Dummy request. Do nothing -data InterruptMain = InterruptMain - deriving stock Show - deriving anyclass Exception --- | Execute python action. It will take and hold global lock while --- code is executed. Python exceptions raised during execution are --- converted to haskell exception 'PyError'. +-- | Execute python action. This is simplest executor with lowest +-- overhead but it comes with several caveats. When thread executes +-- python code it could not be interrupted since it's in foreign +-- call. Use 'runPyAsync' if you need ability to interrupt. Also +-- python uses GIL so only one thread can evaluate python code at +-- time. +-- +-- Python exceptions raised during execution are converted to +-- haskell exception 'PyError'. runPy :: Py a -> IO a -- See NOTE: [Python and threading] runPy py @@ -463,67 +544,245 @@ -- it wasn't. Better than segfault isn't it? 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 --- initialized. Some python's libraries may need that. It has higher --- call overhead compared to 'runPy'. + +-- | This function executes python code on python's main thread. It's +-- OS thread in which interpreter was initialized and it has some +-- special status in python. Some libraries could only work when +-- called from main thread. It has higher call overhead compared to +-- 'runPy' and only one haskell thread could be executing something +-- on main thread at time. +-- +-- When executing on threaded runtime this function could be +-- interrupted by asynchronous exceptions. runPyInMain :: Py a -> IO a --- See NOTE: [Python and threading] +-- See NOTE: [Python and threading, Main thread] runPyInMain py -- Multithreaded RTS | rtsSupportsBoundThreads = do - tid <- myThreadId - bracket (acquireMain tid) fst snd + py_tid <- getPyThreadID + bracket (acquireMain py_tid) fst snd -- Single-threaded RTS | otherwise = runPy py where - acquireMain tid = atomically $ readTVar globalPyState >>= \case + acquireMain py_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_lock tid_main _ -> readTVar globalPyLock >>= \case + RunningN _ eval_lock tid_main tid_main_py _ -> 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_lock - ) - -- If we513 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 - ) + LockReady _ main_lock + -- We're on main thread. We can just run computation and not + -- bother with incrementing thread counter. It's already + -- incremented in outer scope + | py_tid == tid_main_py -> pure ( pure () + , unsafeRunPy $ ensureGIL py + ) + -- Otherwise we need to send closure to main thread for evaluation. + -- We use mutex to make sure that only single request is executed | otherwise -> do - writeTVar globalPyLock $ Locked tid_main (t : ts) - pure ( atomically (releaseLock tid_main) - , evalInOtherThread tid_main eval_lock + takeTMVar main_lock + acquireLock + pure ( atomically (releaseLock >> putTMVar main_lock ()) + , evalInOtherThread tid_main tid_main_py eval_lock ) -- - evalInOtherThread tid_main eval_lock = do - r <- mask_ $ do resp <- newEmptyMVar - putMVar eval_lock $ EvalReq py resp - takeMVar resp `onException` throwTo tid_main InterruptMain + evalInOtherThread tid_main tid_main_py eval_lock = do + r <- mask_ $ do + resp <- newEmptyMVar + alive <- newEmptyMVar + tid_stack <- newTVarIO [] + putMVar eval_lock $ EvalReq py resp alive tid_stack + takeMVar resp `onException` cancelPy PyAsync + { asyncTID = tid_main + , asyncTidStack = tid_stack + , asyncPyTID = pure tid_main_py + , asyncAlive = alive + , asyncWait = retry -- Not used by cancelPy + } either throwM pure r - -- | Execute python action. This function is unsafe and should be only -- called in thread of interpreter. unsafeRunPy :: Py a -> IO a unsafeRunPy (Py io) = io +---------------------------------------------------------------- +-- Async running +---------------------------------------------------------------- +-- NOTE: [Py Async] +-- ~~~~~~~~~~~~~~~~ +-- +-- In order to run python threads concurrently and to be able to +-- cancel them we need to run python in dedicated thread. See NOTE +-- [Interrupting python] for details. +-- +-- `forkOS` seems to provide such functionality although it's not +-- documented explicitly. It allows to provide async-inspired API for +-- interacting with python thread. +-- +-- Most complicated part of API is interrupting python. [Interrupting +-- python] gives high level overview. Here more technical details: +-- +-- + PyThreadState_SetAsyncExc doesn't queue exception. So it very +-- well may be noop if it finds no such thread. We have to repeat +-- interrupting python. +-- +-- + forkOS may reuse OS thread. So we must not attempt interrupt if +-- thread is dead already. + + +-- | Exception thrown to a thread doing async python computation. On +-- python side it corresponds to +-- @inline_python.AsyncCancelled@. Latter is automatically converted +-- to @PyAsyncCancelled@. +-- +-- @since 0.3 +data PyAsyncCancelled = PyAsyncCancelled + deriving (Show, Eq) + +instance Exception PyAsyncCancelled + +-- | Handle to asynchronous python computation spawned by +-- 'runPyAsync'. It's performed on separate OS thread. Use +-- 'waitPy'\/'waitPyCatch' to obtain computation result. +-- +-- @since 0.3 +data PyAsync a = PyAsync + { asyncTID :: !ThreadId -- Thread ID + , asyncTidStack :: !(TVar [ThreadId]) -- Stack of callback thread ID + , asyncPyTID :: !(IO PyThreadId) -- Thread ID used by python + , asyncAlive :: !(MVar Bool) -- Holds True while thread is alive + , asyncWait :: STM (Either SomeException a) + } + +-- | Wait for result of asynchronous computation. If it threw an +-- exception it will be rethrown by @wait@. +-- +-- @since 0.3 +waitPy :: PyAsync a -> STM a +waitPy a = either throwSTM pure =<< a.asyncWait + +-- | Wait for result of asynchronous computation. Exception thrown by +-- it will be returned as @Left@. +-- +-- @since 0.3 +waitPyCatch :: PyAsync a -> STM (Either SomeException a) +waitPyCatch = (.asyncWait) + +-- | Execute python computation on dedicated OS thread. +-- +-- @since 0.3 +runPyAsync :: Py a -> IO (PyAsync a) +runPyAsync py = do + ensureInit + result <- newEmptyTMVarIO + tid_stack <- newTVarIO [] + py_tid_mv <- newEmptyMVar + alive <- newEmptyMVar + -- Worker thread. We must modify liveliness MVar under + -- uninterruptibleMask otherwise it could be interrupted and + -- cancelPy will consider thread alive forever + -- + -- We also clear dangling async python exception in case we have + -- leftover from previous evaluation + tid <- forkOS $ mask_ $ + (do putMVar py_tid_mv =<< getPyThreadID + a <- try + $ withAsyncInitTLS tid_stack + $ ensurePyLock + $ unsafeRunPy + $ ensureGIL $ do Py [CU.exp| void { inline_py_clear_error() } |] + Py $ putMVar alive True + py + atomically $ putTMVar result a + ) `finally` uninterruptibleMask_ (modifyMVar_ alive (\_ -> pure False)) + pure PyAsync + { asyncTID = tid + , asyncTidStack = tid_stack + , asyncPyTID = readMVar py_tid_mv + , asyncWait = takeTMVar result + , asyncAlive = alive + } + +-- Initialize thread local storage for thread created by runPyAsync +withAsyncInitTLS :: TVar [ThreadId] -> IO a -> IO a +withAsyncInitTLS stack = bracket ini fini . const + where + ini = do + s_ptr <- newStablePtr stack + let ptr = castStablePtrToPtr s_ptr + [CU.exp| void { inline_py_init_state($(void* ptr)) } |] + pure s_ptr + fini s_ptr = do + [CU.exp| void { inline_py_free_state() } |] + freeStablePtr s_ptr + + + +-- | Cancel execution of asynchronous computation. It throws +-- 'PyAsyncCancelled' to haskell threads including any haskell +-- callbacks from python. Python will interrupted by asynchronously +-- raising @inline_python.AsyncCancelled@. +-- +-- Note that python code generally is not written under assumption +-- that it could be smitten with exception at an absolutely any +-- moment. It could cause problems. +-- +-- @since 0.3 +cancelPy :: PyAsync a -> IO () +cancelPy PyAsync{asyncTID=tid, asyncTidStack, asyncPyTID, asyncAlive} = do + -- See NOTE: [Py Async], [Interrupting python] + PyThreadId py_tid <- asyncPyTID + -- Interrupting python. We must attempt interrupting only as long as + -- async thread is alive. Else we may end up interrupting wrong + -- thread. + _ <- forkIO $ fix $ \loop -> do + n <- withMVar asyncAlive $ \case + False -> return 1 + True -> [C.block| int { + int gil = PyGILState_Ensure(); + int n = PyThreadState_SetAsyncExc($(uint64_t py_tid), inline_py_AsyncCancelled()); + PyGILState_Release(gil); + return n; + }|] + case n of + 0 -> do + threadDelay 50 -- Avoid hammering interrupt too hard + loop + _ -> return () + -- Interrupting callbacks. We repeatedly try to kill every callbacks + -- that appears on top of stack. It seems to be only working way. + tid_kill_cb <- forkIO $ flip fix Nothing $ \loop t_old -> do + t <- atomically $ readTVar asyncTidStack >>= \case + [] -> retry + t:_ | Just t == t_old -> retry + | otherwise -> pure t + _ <- forkIO $ throwTo t PyAsyncCancelled + loop $ Just t + -- Interrupt haskell + throwTo tid PyAsyncCancelled + killThread tid_kill_cb + +-- | Variant of 'cancel' which isn't interruptible. +-- +-- @since 0.3 +uninterruptibleCancelPy :: PyAsync a -> IO () +uninterruptibleCancelPy = uninterruptibleMask_ . cancelPy + +-- | Create new OS thread and execute python code on it. Will use +-- 'uninterruptibleCancel' after callback finishes execution. +-- +-- @since 0.3 +withPyAsync :: Py a -> (PyAsync a -> IO b) -> IO b +withPyAsync py = bracket (runPyAsync py) uninterruptibleCancelPy + + ---------------------------------------------------------------- -- GC-related functions ---------------------------------------------------------------- @@ -535,9 +794,9 @@ fptr <- newForeignPtr_ p GHC.addForeignPtrFinalizer fptr $ readTVarIO globalPyState >>= \case - RunningN ch _ _ _ -> writeChan ch p - Running1 -> singleThreadedDecrefCG p - _ -> pure () + RunningN ch _ _ _ _ -> writeChan ch p + Running1 -> singleThreadedDecrefCG p + _ -> pure () pure $ PyObject fptr -- | Thread doing garbage collection for python object in @@ -550,23 +809,19 @@ decrefGC p = join $ atomically $ readTVar globalPyLock >>= \case LockUninialized -> pure $ pure () LockFinalized -> pure $ pure () - LockedByGC -> pure $ pure () - Locked{} -> retry - LockUnlocked -> do - writeTVar globalPyLock LockedByGC + LockReady n _ -> do + modifyTVar' n succ pure $ do - gcDecref p `finally` atomically (writeTVar globalPyLock LockUnlocked) + gcDecref p `finally` atomically (modifyTVar' n pred) singleThreadedDecrefCG :: Ptr PyObject -> IO () singleThreadedDecrefCG p = readTVarIO globalPyLock >>= \case LockUninialized -> pure () LockFinalized -> pure () - LockedByGC -> gcDecref p - Locked{} -> gcDecref p - LockUnlocked -> gcDecref p + LockReady{} -> 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 +838,7 @@ -- 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,9 +849,16 @@ -- 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)) } |] +-- | Removes exception masking and releases GIL temporarily +instance MonadIO Py where + liftIO = dropGIL . interruptible + +getPyThreadID :: IO PyThreadId +getPyThreadID = PyThreadId <$> [CU.exp| uint64_t { PyThread_get_thread_ident() } |] + ---------------------------------------------------------------- -- Conversion of exceptions ---------------------------------------------------------------- @@ -605,35 +867,50 @@ -- NULL. convertHaskell2Py :: SomeException -> Py (Ptr PyObject) convertHaskell2Py err = Py $ do - withCString ("Haskell exception: "++show err) $ \p_err -> do - [CU.block| PyObject* { - PyErr_SetString(PyExc_RuntimeError, $(char *p_err)); - return NULL; - } |] + s_ptr <- newStablePtr err + let ptr = castStablePtrToPtr s_ptr + [C.block| PyObject* { + PyObject* exc = inline_py_HaskellError_create($(void* ptr)); + PyErr_SetObject(inline_py_HaskellError(), exc); + Py_DECREF(exc); + return NULL; + } |] -- | Convert python exception to haskell exception. Should only be -- called if there's unhandled python exception. Clears exception. -convertPy2Haskell :: Py PyException +convertPy2Haskell :: Py SomeException convertPy2Haskell = runProgram $ do p_errors <- withPyAllocaArray @(Ptr PyObject) 3 - -- Fetch error indicator - (p_type, p_value) <- progIO $ 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. + -- Fetch error information + progIO [CU.block| void { + PyObject **p = $(PyObject** p_errors); + PyErr_Fetch(p, p+1, p+2); + }|] + -- Fetch exception type. + -- + -- NOTE: When we set exception using PyThreadState_SetAsyncExc this + -- field remains NULL on python<=3.11. Thus we must use xdecref + p_type <- progPyBracket $ (Py $ peekElemOff p_errors 0) `bracket` decref + p_value <- progPyBracket $ (Py $ peekElemOff p_errors 1) `bracket` xdecref + _trace <- progPyBracket $ (Py $ peekElemOff p_errors 2) `bracket` xdecref + -- Should we convert to PyAsyncCancelled? + ty_async_cancelled <- progIO [CU.exp| PyObject* { inline_py_AsyncCancelled() } |] + when (p_type == ty_async_cancelled) $ do + abort $ SomeException PyAsyncCancelled + -- Should we convert to haskell exception? + ty_hask_err <- progIO [CU.exp| PyObject* { inline_py_HaskellError() } |] + when (p_type == ty_hask_err) $ do + s_ptr <- progIO [CU.exp| void* { inline_py_HaskellError_get_stableptr($(PyObject* p_value)) } |] + err <- progIO $ deRefStablePtr $ castPtrToStablePtr s_ptr + abort err + -- Convert any other python exception progPy $ do s_type <- pyobjectStrAsHask p_type s_value <- pyobjectStrAsHask p_value incref p_value exc <- newPyObject p_value let bad_str = "__str__ call failed" - pure $ PyException + pure $ SomeException $ PyError $ PyException { ty = fromMaybe bad_str s_type , str = fromMaybe bad_str s_value , exception = exc @@ -644,7 +921,7 @@ checkThrowPyError = Py [CU.exp| PyObject* { PyErr_Occurred() } |] >>= \case NULL -> pure () - _ -> throwM . PyError =<< convertPy2Haskell + _ -> throwM =<< convertPy2Haskell -- | Throw python error as haskell exception if it's raised. If it's -- not that internal error. Another exception will be raised @@ -652,7 +929,7 @@ mustThrowPyError = Py [CU.exp| PyObject* { PyErr_Occurred() } |] >>= \case NULL -> error $ "mustThrowPyError: no python exception raised." - _ -> throwM . PyError =<< convertPy2Haskell + _ -> throwM =<< convertPy2Haskell -- | Calls mustThrowPyError if pointer is null or returns it unchanged throwOnNULL :: Ptr PyObject -> Py (Ptr PyObject) @@ -696,7 +973,7 @@ 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 +1020,7 @@ 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; @@ -820,6 +1097,35 @@ {-# SPECIALIZE exec :: Main -> Main -> PyQuote -> Py () #-} {-# SPECIALIZE exec :: Main -> Temp -> PyQuote -> Py () #-} +-- | Evaluate code as if it's a function body and bound arguments are +-- parameters to that function. Just like function it could return +-- value and always creates new scope. +-- +-- @since 0.3 +evalPyFunction + :: Namespace global + => global -- ^ Global variables + -> PyQuoteFun -- ^ Source code + -> Py PyObject +evalPyFunction globals (PyQuoteFun code binder) = runProgram $ do + p_locals <- takeOwnership =<< progPy basicNewDict + p_kwargs <- takeOwnership =<< progPy basicNewDict + progPy $ do + -- Create function in p_locals + exec globals (DictPtr p_locals) (PyQuote code mempty) + -- Look up function + p_fun <- getFunctionObject p_locals >>= \case + NULL -> throwM $ PyInternalError "_inline_python_ must be present" + p -> pure p + -- Call python function we just constructed + binder.bind p_kwargs + newPyObject =<< throwOnNULL =<< basicCallKwdOnly p_fun p_kwargs + +getFunctionObject :: Ptr PyObject -> Py (Ptr PyObject) +getFunctionObject p_dict = do + Py [CU.exp| PyObject* { PyDict_GetItemString($(PyObject *p_dict), "_inline_python_") } |] + + -- | Obtain pointer to code unsafeWithCode :: Code -> Program r (Ptr CChar) unsafeWithCode (Code bs) = Program $ ContT $ \fun -> @@ -831,7 +1137,7 @@ ---------------------------------------------------------------- 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)) ); } |] diff --git a/src/Python/Internal/EvalQQ.hs b/src/Python/Internal/EvalQQ.hs --- a/src/Python/Internal/EvalQQ.hs +++ b/src/Python/Internal/EvalQQ.hs @@ -2,16 +2,12 @@ {-# LANGUAGE TemplateHaskell #-} -- | module Python.Internal.EvalQQ - ( -- * Evaluators and QQ - evaluatorPyf - -- * Code generation - , expQQ + ( -- * Code generation + expQQ , Mode(..) ) where import Control.Monad.IO.Class -import Control.Monad.Catch -import Control.Monad.Trans.Cont (ContT(..)) import Data.Bits import Data.Char import Data.List (intercalate) @@ -32,7 +28,6 @@ import Python.Internal.Types import Python.Internal.Program import Python.Internal.Eval -import Python.Internal.CAPI import Python.Inline.Literal @@ -42,12 +37,16 @@ ---------------------------------------------------------------- -- | Python's variable name encoded using UTF-8. It exists in order to --- avoid working with @String@ at runtime. +-- avoid working with @String@ at runtime. Bytestring should be NULL +-- terminated manually newtype PyVarName = PyVarName BS.ByteString deriving stock (Show, TH.Lift) +-- | PyVarName is being consumed using 'BS.unsafeUseAsCString' which +-- doesn't NULL terminate underlying buffer and python's C API +-- require it. We have to add terminator ourselves varName :: String -> PyVarName -varName = PyVarName . T.encodeUtf8 . T.pack +varName nm = PyVarName $ flip BS.snoc 0 $ T.encodeUtf8 (T.pack nm) unsafeWithPyVarName :: PyVarName -> Program r (Ptr CChar) unsafeWithPyVarName (PyVarName bs) @@ -70,31 +69,6 @@ ---------------------------------------------------------------- --- Evaluators ----------------------------------------------------------------- - -evaluatorPyf :: PyQuote -> Py PyObject -evaluatorPyf (PyQuote code binder) = runProgram $ do - p_locals <- takeOwnership =<< progPy basicNewDict - p_kwargs <- takeOwnership =<< progPy basicNewDict - progPy $ do - -- Create function in p_locals - exec Main (DictPtr p_locals) (PyQuote code mempty) - -- Look up function - p_fun <- getFunctionObject p_locals >>= \case - NULL -> throwM $ PyInternalError "_inline_python_ must be present" - p -> pure p - -- Call python function we just constructed - binder.bind p_kwargs - newPyObject =<< throwOnNULL =<< basicCallKwdOnly p_fun p_kwargs - -getFunctionObject :: Ptr PyObject -> Py (Ptr PyObject) -getFunctionObject p_dict = do - Py [CU.exp| PyObject* { PyDict_GetItemString($(PyObject *p_dict), "_inline_python_") } |] - - - ----------------------------------------------------------------- -- TH generator ---------------------------------------------------------------- @@ -116,8 +90,7 @@ -> TH.Q TH.Exp expQQ mode qq_src = do -- We need to preprocess before passing it to python. - let src = prepareSource mode qq_src - src_var = prepareForVarLookup mode src + let src = prepareSource mode qq_src antis <- liftIO $ do -- We've embedded script into library and we need to pass source -- code of QQ to a script. It can contain whatever symbols so to @@ -133,7 +106,7 @@ , "decode_and_print('" <> concat [ [ intToDigit $ fromIntegral (w `shiftR` 4) , intToDigit $ fromIntegral (w .&. 15) ] - | w <- BS.unpack $ T.encodeUtf8 $ T.pack src_var + | w <- BS.unpack $ T.encodeUtf8 $ T.pack src ] <> "')" ] @@ -145,9 +118,10 @@ ] src_eval = prepareForEval mode antis src -- - [| PyQuote ($(TH.lift $ codeFromString src_eval)) - (mconcat $(TH.listE args)) - |] + case mode of + Eval -> [| PyQuote ($(TH.lift $ codeFromString src_eval)) (mconcat $(TH.listE args)) |] + Exec -> [| PyQuote ($(TH.lift $ codeFromString src_eval)) (mconcat $(TH.listE args)) |] + Fun -> [| PyQuoteFun ($(TH.lift $ codeFromString src_eval)) (mconcat $(TH.listE args)) |] antiSuffix :: String @@ -167,12 +141,6 @@ Eval -> dropWhile isSpace Exec -> unindent Fun -> unindent - -prepareForVarLookup :: Mode -> String -> String -prepareForVarLookup = \case - Eval -> id - Exec -> id - Fun -> ("def __dummy__():\n"++) . indent prepareForEval :: Mode -> [String] -> String -> String prepareForEval mode vars src = case mode of diff --git a/src/Python/Internal/Program.hs b/src/Python/Internal/Program.hs --- a/src/Python/Internal/Program.hs +++ b/src/Python/Internal/Program.hs @@ -6,6 +6,7 @@ , runProgram , progPy , progIO + , progPyBracket , progIOBracket -- * Control flow , abort @@ -38,7 +39,6 @@ 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 @@ -68,6 +68,9 @@ progIOBracket :: ((a -> IO r) -> IO r) -> Program r a progIOBracket = coerce +progPyBracket :: ((a -> Py r) -> Py r) -> Program r a +progPyBracket = coerce + -- | Early exit from continuation monad. abort :: r -> Program r a abort r = Program $ ContT $ \_ -> pure r @@ -131,14 +134,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(); diff --git a/src/Python/Internal/Types.hs b/src/Python/Internal/Types.hs --- a/src/Python/Internal/Types.hs +++ b/src/Python/Internal/Types.hs @@ -15,10 +15,12 @@ , PyError(..) , PyException(..) , PyInternalError(..) + , PyThreadId(..) , Py(..) , pyIO -- ** Python code wrappers , PyQuote(..) + , PyQuoteFun(..) , Code(..) , codeFromText , codeFromString @@ -34,13 +36,14 @@ , pattern TRUE ) where -import Control.Monad.IO.Class import Control.Monad.Catch import Control.Monad.Primitive (PrimMonad(..),RealWorld) -import Control.Exception import Data.Coerce import Data.Int +import Data.Word import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as BL +import Data.ByteString.Builder qualified as BB import Data.Map.Strict qualified as Map import Data.Text qualified as T import Data.Text.Encoding qualified as T @@ -120,16 +123,17 @@ pyIO :: IO a -> Py a pyIO = Py --- | Removes exception masking -instance MonadIO Py where - liftIO = Py . interruptible - instance PrimMonad Py where type PrimState Py = RealWorld primitive = Py . primitive {-# INLINE primitive #-} +-- | Identifier of python's thread as python understands them. +newtype PyThreadId = PyThreadId Word64 + deriving stock (Show,Eq,Ord) + + ---------------------------------------------------------------- -- Code wrappers ---------------------------------------------------------------- @@ -146,6 +150,18 @@ } +-- | Quasiquoted body of python function which could be used by +-- 'Python.Inline.Eval.evalPyFunction'. Function body must be +-- wrapped in @_inline_python_@ function which quasiquoter +-- 'Python.Inline.QQ.pyfun' does automatically. +-- +-- @since 0.3@ +data PyQuoteFun = PyQuoteFun + { code :: !Code + , binder :: !DictBinder + } + + -- | UTF-8 encoded python source code. -- -- @since 0.2@ @@ -157,7 +173,13 @@ -- -- @since 0.2@ codeFromText :: T.Text -> Code -codeFromText = Code . T.encodeUtf8 +-- NOTE: We consume code with BS.useAsCString and python C API expect +-- NULL-terminated string. We have to add terminator manually +codeFromText code + = Code + $ BL.toStrict + $ BB.toLazyByteString + $ T.encodeUtf8Builder code <> BB.word8 0 -- | Create properly encoded @Code@. This function doesn't check -- syntactic validity. diff --git a/test/TST/Callbacks.hs b/test/TST/Callbacks.hs --- a/test/TST/Callbacks.hs +++ b/test/TST/Callbacks.hs @@ -1,6 +1,7 @@ -- | module TST.Callbacks (tests) where +import Control.Exception import Test.Tasty import Test.Tasty.HUnit import Python.Inline @@ -68,11 +69,21 @@ , 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) |] + throwsException DivideByZero [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) |] + throwsException DivideByZero [py_| foo_hs(1, 0) |] + , testCase "Haskell exception has correct type" $ runPy $ do + let foo :: Int -> IO Int + foo y = pure $ 10 `div` y + [py_| + import inline_python + try: + foo_hs(0) + except inline_python.HaskellError as e: + assert repr(e) == "", repr(e) + |] ---------------------------------------- , testCase "Call python in callback (arity=1)" $ runPy $ do let foo :: Int -> IO Int diff --git a/test/TST/Module.hs b/test/TST/Module.hs new file mode 100644 --- /dev/null +++ b/test/TST/Module.hs @@ -0,0 +1,44 @@ +-- | +module TST.Module where + +import Control.Exception +import Data.Typeable +import Test.Tasty +import Test.Tasty.HUnit +import Python.Inline +import Python.Inline.QQ +import Python.Inline.Async + +tests :: TestTree +tests = testGroup "Builtin module" + [ testCase "Module exists" $ runPy [py_| import inline_python |] + , testCase "Exceptions" $ runPy [py_| + import inline_python + assert issubclass(inline_python.AsyncCancelled, BaseException) + assert not issubclass(inline_python.AsyncCancelled, Exception) + + assert issubclass(inline_python.HaskellError, Exception), "HaskellError is Exception" + assert issubclass(inline_python.HaskellError, BaseException), "HaskellError is BaseException" + |] + -- We want to check that inline_python types are stable under + -- reload using importlib. + , testCase "importlib.reload stable" $ runPy [py_| + import inline_python + import importlib + ty = inline_python.AsyncCancelled + err = ty() + importlib.reload(inline_python) + assert ty is inline_python.AsyncCancelled + assert isinstance(err, inline_python.AsyncCancelled) + |] + , testCase "AsyncCancelled is converted to PyAsyncCancelled" $ do + r :: Either SomeException () <- try $ runPy [py_| + import inline_python + raise inline_python.AsyncCancelled() + |] + case r of + Right () -> error "No exception" + Left (SomeException e) + | Just PyAsyncCancelled <- cast e -> pure () + | otherwise -> throwIO e + ] diff --git a/test/TST/Run.hs b/test/TST/Run.hs --- a/test/TST/Run.hs +++ b/test/TST/Run.hs @@ -3,26 +3,42 @@ module TST.Run(tests) where import Control.Concurrent +import Control.Concurrent.STM import Control.Exception import Control.Monad import Control.Monad.IO.Class import Data.Map.Strict qualified as Map +import Data.Text qualified as T import Test.Tasty import Test.Tasty.HUnit import Python.Inline import Python.Inline.QQ import Python.Inline.Eval +import Python.Inline.Async import TST.Util tests :: TestTree tests = testGroup "Run python" [ testCase "Empty QQ" $ runPy [py_| |] , testCase "Second init is noop" $ initializePython - , testCase "Nested runPy" $ runPy $ liftIO $ runPy $ pure () + , testRunPy + , testScope + , testEvalExec + , testMonadic + , testAsync + ] + +-- Test that python evaluation works in general and its interaction +-- with exceptions +testRunPy :: TestTree +testRunPy = testGroup "Running python" + [ 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() + tid_main = threading.main_thread() + tid_our = threading.current_thread() + assert tid_main == tid_our, f"TID[main]={tid_main}, TID[our]={tid_our}" |] , testCase "Python exceptions are converted (py)" $ runPy $ throwsPy [py_| 1 / 0 |] , testCase "Python exceptions are converted (std)" $ throwsPyIO $ runPy [py_| 1 / 0 |] @@ -31,18 +47,21 @@ 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 + , testCase "Exception in runPyInMain works hask" $ do lock <- newEmptyMVar tid <- myThreadId - _ <- forkIO $ takeMVar lock >> throwTo tid Stop + _ <- forkIO $ takeMVar lock >> threadDelay 1000 >> 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 + ] + +-- Test that different quasiquotes correctly handle scoping +testScope :: TestTree +testScope = testGroup "Python scope" + [ testCase "Scope pymain->any" $ runPy $ do [pymain| x = 12 x @@ -133,7 +152,11 @@ except NameError: pass |] - , testCase "pyf works" $ do + ] + +testEvalExec :: TestTree +testEvalExec = testGroup "eval/exec" + [ testCase "pyf works" $ do let x = 12 :: Int eq (Just (482412::Int)) [pyf| xs = [i*x_hs for i in [1, 200, 40000]] @@ -164,8 +187,100 @@ assert m_hs.a == 12 assert m_hs.b == 'asd' |] + , testCase "evalPyFunction" $ runPy $ do + let n = 2 :: Int + x <- fromPy =<< evalPyFunction Temp [pyfun| return 100 * n_hs |] + liftIO $ Just (200::Int) @=? x + , testCase "createModule" $ runPy $ do + m <- createModule (T.pack "foo") [pycode||] + [py_| + import types + assert isinstance(m_hs, types.ModuleType) + |] ] +testAsync :: TestTree +testAsync = testGroup "async" $ guardThreaded + [ -- We can run async computation at all + testCase "runPyAsync" $ do + runPy [pymain| dct = {} |] + a <- runPyAsync $ [py_| dct[1] = 100 |] + _ <- atomically $ waitPy a + n <- runPy $ fromPy =<< [pye| dct[1] |] + assertEqual "x" (Just (100::Int)) n + runPy [pymain| del dct |] + , -- Cancellation of python code + testCase "cancelPy [python]" $ do + a <- runPyAsync $ forever $ [py_| + import time + while True: + time.sleep(1e-3) + |] + d <- registerDelay 100_000 + threadDelay 100 -- Wait to make sure execution actually started + cancelPy a + _ <- atomically $ waitPyCatch a `orElse` do readTVar d >>= \case + True -> error "Timeout" + False -> retry + return () + , -- Cancellation of haskell code + testCase "cancelPy [haskell]" $ do + a <- runPyAsync $ do + liftIO $ forever $ threadDelay 1_000_000 + d <- registerDelay 100_000 + threadDelay 100 + cancelPy a + _ <- atomically $ waitPyCatch a `orElse` do readTVar d >>= \case + True -> error "Timeout" + False -> retry + return () + , -- Cancellation of haskell code + testCase "cancelPy [callback]" $ do + a <- runPyAsync $ do + let loop = forever $ threadDelay 1_000_000 :: IO () + forever [py_| loop_hs() |] + d <- registerDelay 100_000 + threadDelay 100 + _ <- forkIO $ cancelPy a + _ <- atomically $ waitPyCatch a `orElse` do readTVar d >>= \case + True -> error "Timeout" + False -> retry + return () + , testCase "Exception in runPyInMain works py" $ do + lock <- newEmptyMVar + tid <- myThreadId + _ <- forkIO $ takeMVar lock >> threadDelay 1000 >> throwTo tid Stop + handle (\Stop -> pure ()) + $ runPyInMain + $ do liftIO $ putMVar lock () + [py_| + import time + while True: + time.sleep(1e-3) + |] + error "Should be interrupted" + ] + + +-- Here we only test that quasiquotes produce correct code +testMonadic :: TestTree +testMonadic = testGroup "Monadic" + [ testCase "pymain" $ runPy [pymain| assert True |] + , testCase "py_" $ runPy [py_| assert True |] + , testCase "pye" $ runPy $ do + n <- fromPy =<< [pye| 42 |] + liftIO $ Just (42::Int) @=? n + , testCase "pyf" $ runPy $ do + n <- fromPy =<< [pyf| return 42 |] + liftIO $ Just (42::Int) @=? n + ] + + data Stop = Stop deriving stock Show deriving anyclass Exception + +guardThreaded :: [TestTree] -> [TestTree] +guardThreaded ts + | rtsSupportsBoundThreads = ts + | otherwise = [] diff --git a/test/TST/Util.hs b/test/TST/Util.hs --- a/test/TST/Util.hs +++ b/test/TST/Util.hs @@ -3,6 +3,7 @@ import Control.Monad.IO.Class import Control.Monad.Catch +import Data.Typeable import Test.Tasty.HUnit import Python.Inline @@ -10,6 +11,12 @@ throwsPy :: Py () -> Py () throwsPy io = (io >> liftIO (assertFailure "Evaluation should raise python exception")) `catch` (\(_::PyError) -> pure ()) + +throwsException :: (Exception e, Eq e) => e -> Py () -> Py () +throwsException e0 io = (io >> liftIO (assertFailure "Evaluation should raise python exception")) + `catch` (\(SomeException e) -> case cast e of Just e' | e' == e0 -> pure () + _ -> throwM e + ) throwsPyIO :: IO () -> IO () throwsPyIO io = (io >> assertFailure "Evaluation should raise python exception") diff --git a/test/exe/main.hs b/test/exe/main.hs --- a/test/exe/main.hs +++ b/test/exe/main.hs @@ -7,6 +7,7 @@ import TST.ToPy import TST.Callbacks import TST.Roundtrip +import TST.Module import Python.Inline main :: IO () @@ -16,4 +17,5 @@ , TST.ToPy.tests , TST.Roundtrip.tests , TST.Callbacks.tests + , TST.Module.tests ]