Skip to content

Commit 67e11b0

Browse files
ShimuuarShimuuar
committed
Implement quasiquotes in term of simple eval/exec
Except pyf. It's more complicated
1 parent 4201e87 commit 67e11b0

File tree

5 files changed

+174
-237
lines changed

5 files changed

+174
-237
lines changed

‎src/Python/Inline/Eval.hs‎

Lines changed: 0 additions & 103 deletions
Original file line numberDiff line numberDiff line change
@@ -19,109 +19,6 @@ module Python.Inline.Eval
1919

2020
) where
2121

22-
import Foreign.Ptr
23-
24-
import Language.C.Inline qualified as C
25-
import Language.C.Inline.Unsafe qualified as CU
26-
2722
import Python.Internal.Types
2823
import Python.Internal.Eval
29-
import Python.Internal.EvalQQ
30-
import Python.Internal.CAPI
31-
import Python.Internal.Program
32-
33-
----------------------------------------------------------------
34-
C.context (C.baseCtx <> pyCtx)
35-
C.include "<inline-python.h>"
36-
----------------------------------------------------------------
37-
38-
39-
-- | Evaluate python expression
40-
eval :: (Namespace global, Namespace local)
41-
=> global -- ^ Data type providing global variables dictionary
42-
-> local -- ^ Data type providing local variables dictionary
43-
-> PyQuote -- ^ Source code
44-
-> Py PyObject
45-
eval globals locals q = runProgram $ do
46-
p_py <- unsafeWithCode q.code
47-
p_globals <- takeOwnership =<< progPy (basicNamespaceDict globals)
48-
p_locals <- takeOwnership =<< progPy (basicNamespaceDict locals)
49-
progPy $ do
50-
q.binder.bind p_locals
51-
p_res <- Py [C.block| PyObject* {
52-
PyObject* globals = $(PyObject* p_globals);
53-
PyObject* locals = $(PyObject* p_locals);
54-
// Compile code
55-
PyObject *code = Py_CompileString($(char* p_py), "<interactive>", Py_eval_input);
56-
if( PyErr_Occurred() ) {
57-
return NULL;
58-
}
59-
// Evaluate expression
60-
PyObject* r = PyEval_EvalCode(code, globals, locals);
61-
Py_DECREF(code);
62-
return r;
63-
}|]
64-
checkThrowPyError
65-
newPyObject p_res
66-
{-# SPECIALIZE eval :: Main -> Temp -> PyQuote -> Py PyObject #-}
67-
68-
-- | Evaluate sequence of python statements
69-
exec :: (Namespace global, Namespace local)
70-
=> global -- ^ Data type providing global variables dictionary
71-
-> local -- ^ Data type providing local variables dictionary
72-
-> PyQuote -- ^ Source code
73-
-> Py ()
74-
exec globals locals q = runProgram $ do
75-
p_py <- unsafeWithCode q.code
76-
p_globals <- takeOwnership =<< progPy (basicNamespaceDict globals)
77-
p_locals <- takeOwnership =<< progPy (basicNamespaceDict locals)
78-
progPy $ do
79-
q.binder.bind p_locals
80-
Py[C.block| void {
81-
PyObject* globals = $(PyObject* p_globals);
82-
PyObject* locals = $(PyObject* p_locals);
83-
// Compile code
84-
PyObject *code = Py_CompileString($(char* p_py), "<interactive>", Py_file_input);
85-
if( PyErr_Occurred() ){
86-
return;
87-
}
88-
// Execute statements
89-
PyObject* res = PyEval_EvalCode(code, globals, locals);
90-
Py_XDECREF(res);
91-
Py_DECREF(code);
92-
} |]
93-
checkThrowPyError
94-
{-# SPECIALIZE exec :: Main -> Main -> PyQuote -> Py () #-}
95-
{-# SPECIALIZE exec :: Main -> Temp -> PyQuote -> Py () #-}
96-
97-
98-
99-
-- | Type class for values representing python dictionaries containing
100-
-- global or local variables.
101-
class Namespace a where
102-
-- | Returns dictionary object. Caller takes ownership of returned
103-
-- object.
104-
basicNamespaceDict :: a -> Py (Ptr PyObject)
105-
106-
107-
-- | Namespace for the top level code execution.
108-
data Main = Main
109-
110-
111-
instance Namespace Main where
112-
-- NOTE: dupe of basicMainDict
113-
basicNamespaceDict _ =
114-
throwOnNULL =<< Py [CU.block| PyObject* {
115-
PyObject* main_module = PyImport_AddModule("__main__");
116-
if( PyErr_Occurred() )
117-
return NULL;
118-
PyObject* dict = PyModule_GetDict(main_module);
119-
Py_XINCREF(dict);
120-
return dict;
121-
}|]
122-
123-
-- | Temporary namespace which get destroyed after execution
124-
data Temp = Temp
12524

126-
instance Namespace Temp where
127-
basicNamespaceDict _ = basicNewDict

‎src/Python/Inline/QQ.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ module Python.Inline.QQ
3939
import Language.Haskell.TH.Quote
4040

4141
import Python.Internal.EvalQQ
42+
import Python.Internal.Eval
4243

4344

4445
-- | Evaluate sequence of python statements. It works in the same way
@@ -48,7 +49,7 @@ import Python.Internal.EvalQQ
4849
-- It creates value of type @Py ()@
4950
pymain :: QuasiQuoter
5051
pymain = QuasiQuoter
51-
{ quoteExp = \txt -> [| evaluatorPymain $(expQQ Exec txt) |]
52+
{ quoteExp = \txt -> [| exec Main Main $(expQQ Exec txt) |]
5253
, quotePat = error "quotePat"
5354
, quoteType = error "quoteType"
5455
, quoteDec = error "quoteDec"
@@ -61,7 +62,7 @@ pymain = QuasiQuoter
6162
-- It creates value of type @Py ()@
6263
py_ :: QuasiQuoter
6364
py_ = QuasiQuoter
64-
{ quoteExp = \txt -> [| evaluatorPy_ $(expQQ Exec txt) |]
65+
{ quoteExp = \txt -> [| exec Main Temp $(expQQ Exec txt) |]
6566
, quotePat = error "quotePat"
6667
, quoteType = error "quoteType"
6768
, quoteDec = error "quoteDec"
@@ -73,7 +74,7 @@ py_ = QuasiQuoter
7374
-- This quote creates object of type @Py PyObject@
7475
pye :: QuasiQuoter
7576
pye = QuasiQuoter
76-
{ quoteExp = \txt -> [| evaluatorPye $(expQQ Eval txt) |]
77+
{ quoteExp = \txt -> [| eval Main Temp $(expQQ Eval txt) |]
7778
, quotePat = error "quotePat"
7879
, quoteType = error "quoteType"
7980
, quoteDec = error "quoteDec"

‎src/Python/Internal/Eval.hs‎

Lines changed: 118 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,14 @@ module Python.Internal.Eval
2929
, mustThrowPyError
3030
, checkThrowBadPyType
3131
, throwOnNULL
32+
-- * Exec & eval
33+
, Namespace(..)
34+
, Main(..)
35+
, Temp(..)
36+
, PtrNamespace(..)
37+
, unsafeWithCode
38+
, eval
39+
, exec
3240
-- * Debugging
3341
, debugPrintPy
3442
) where
@@ -42,6 +50,8 @@ import Control.Monad.IO.Class
4250
import Control.Monad.Trans.Cont
4351
import Data.Maybe
4452
import Data.Function
53+
import Data.ByteString qualified as BS
54+
import Data.ByteString.Unsafe qualified as BS
4555
import Foreign.Concurrent qualified as GHC
4656
import Foreign.Ptr
4757
import Foreign.ForeignPtr
@@ -662,6 +672,114 @@ checkThrowBadPyType = do
662672
_ -> throwM BadPyType
663673

664674

675+
----------------------------------------------------------------
676+
-- Eval/exec
677+
----------------------------------------------------------------
678+
679+
-- | Type class for values representing python dictionaries containing
680+
-- global or local variables.
681+
class Namespace a where
682+
-- | Returns dictionary object. Caller takes ownership of returned
683+
-- object.
684+
basicNamespaceDict :: a -> Py (Ptr PyObject)
685+
686+
687+
-- | Namespace for the top level code execution.
688+
data Main = Main
689+
690+
691+
instance Namespace Main where
692+
-- NOTE: almost dupe of basicMainDict
693+
basicNamespaceDict _ =
694+
throwOnNULL =<< Py [CU.block| PyObject* {
695+
PyObject* main_module = PyImport_AddModule("__main__");
696+
if( PyErr_Occurred() )
697+
return NULL;
698+
PyObject* dict = PyModule_GetDict(main_module);
699+
Py_XINCREF(dict);
700+
return dict;
701+
}|]
702+
703+
-- | Temporary namespace which get destroyed after execution
704+
data Temp = Temp
705+
706+
instance Namespace Temp where
707+
basicNamespaceDict _ = basicNewDict
708+
709+
-- | Newtype wrapper for bare python object. It's assumed to be a
710+
-- dictionary. This is not checked.
711+
newtype PtrNamespace = PtrNamespace (Ptr PyObject)
712+
713+
instance Namespace PtrNamespace where
714+
basicNamespaceDict (PtrNamespace p) = do
715+
Py [CU.block| void { Py_XINCREF($(PyObject* p)); } |]
716+
return p
717+
718+
719+
-- | Evaluate python expression
720+
eval :: (Namespace global, Namespace local)
721+
=> global -- ^ Data type providing global variables dictionary
722+
-> local -- ^ Data type providing local variables dictionary
723+
-> PyQuote -- ^ Source code
724+
-> Py PyObject
725+
eval globals locals q = runProgram $ do
726+
p_py <- unsafeWithCode q.code
727+
p_globals <- takeOwnership =<< progPy (basicNamespaceDict globals)
728+
p_locals <- takeOwnership =<< progPy (basicNamespaceDict locals)
729+
progPy $ do
730+
q.binder.bind p_locals
731+
p_res <- Py [C.block| PyObject* {
732+
PyObject* globals = $(PyObject* p_globals);
733+
PyObject* locals = $(PyObject* p_locals);
734+
// Compile code
735+
PyObject *code = Py_CompileString($(char* p_py), "<interactive>", Py_eval_input);
736+
if( PyErr_Occurred() ) {
737+
return NULL;
738+
}
739+
// Evaluate expression
740+
PyObject* r = PyEval_EvalCode(code, globals, locals);
741+
Py_DECREF(code);
742+
return r;
743+
}|]
744+
checkThrowPyError
745+
newPyObject p_res
746+
{-# SPECIALIZE eval :: Main -> Temp -> PyQuote -> Py PyObject #-}
747+
748+
-- | Evaluate sequence of python statements
749+
exec :: (Namespace global, Namespace local)
750+
=> global -- ^ Data type providing global variables dictionary
751+
-> local -- ^ Data type providing local variables dictionary
752+
-> PyQuote -- ^ Source code
753+
-> Py ()
754+
exec globals locals q = runProgram $ do
755+
p_py <- unsafeWithCode q.code
756+
p_globals <- takeOwnership =<< progPy (basicNamespaceDict globals)
757+
p_locals <- takeOwnership =<< progPy (basicNamespaceDict locals)
758+
progPy $ do
759+
q.binder.bind p_locals
760+
Py[C.block| void {
761+
PyObject* globals = $(PyObject* p_globals);
762+
PyObject* locals = $(PyObject* p_locals);
763+
// Compile code
764+
PyObject *code = Py_CompileString($(char* p_py), "<interactive>", Py_file_input);
765+
if( PyErr_Occurred() ){
766+
return;
767+
}
768+
// Execute statements
769+
PyObject* res = PyEval_EvalCode(code, globals, locals);
770+
Py_XDECREF(res);
771+
Py_DECREF(code);
772+
} |]
773+
checkThrowPyError
774+
{-# SPECIALIZE exec :: Main -> Main -> PyQuote -> Py () #-}
775+
{-# SPECIALIZE exec :: Main -> Temp -> PyQuote -> Py () #-}
776+
777+
-- | Obtain pointer to code
778+
unsafeWithCode :: Code -> Program r (Ptr CChar)
779+
unsafeWithCode (Code bs) = Program $ ContT $ \fun ->
780+
Py (BS.unsafeUseAsCString bs $ unsafeRunPy . fun)
781+
782+
665783
----------------------------------------------------------------
666784
-- Debugging
667785
----------------------------------------------------------------

0 commit comments

Comments
 (0)