diff --git a/CPython.chs b/CPython.chs deleted file mode 100644 --- a/CPython.chs +++ /dev/null @@ -1,370 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython - ( initialize - , isInitialized - , finalize - , newInterpreter - , endInterpreter - , getProgramName - , setProgramName - , getPrefix - , getExecPrefix - , getProgramFullPath - , getPath - , getVersion - , getPlatform - , getCopyright - , getCompiler - , getBuildInfo - , setArgv - , getPythonHome - , setPythonHome - ) where -import Data.Text (Text) -import CPython.Internal - -#include - --- | Initialize the Python interpreter. In an application embedding Python, --- this should be called before using any other Python/C API computations; --- with the exception of 'setProgramName', 'initThreads', --- 'releaseLock', and 'acquireLock'. This initializes the table --- of loaded modules (@sys.modules@), and creates the fundamental modules --- @builtins@, @__main__@ and @sys@. It also initializes the module search --- path (@sys.path@). It does not set @sys.argv@; use 'setArgv' for that. This --- is a no-op when called for a second time (without calling 'finalize' --- first). There is no return value; it is a fatal error if the initialization --- fails. --- -{# fun Py_Initialize as initialize - {} -> `()' id #} - --- | Return 'True' when the Python interpreter has been initialized, 'False' --- if not. After 'finalize' is called, this returns 'False' until --- 'initialize' is called again. --- -{# fun Py_IsInitialized as isInitialized - {} -> `Bool' #} - --- | Undo all initializations made by 'initialize' and subsequent use of --- Python/C API computations, and destroy all sub-interpreters (see --- 'newInterpreter' below) that were created and not yet destroyed since the --- last call to 'initialize'. Ideally, this frees all memory allocated by the --- Python interpreter. This is a no-op when called for a second time (without --- calling 'initialize' again first). There is no return value; errors during --- finalization are ignored. - --- This computation is provided for a number of reasons. An embedding --- application might want to restart Python without having to restart the --- application itself. An application that has loaded the Python interpreter --- from a dynamically loadable library (or DLL) might want to free all memory --- allocated by Python before unloading the DLL. During a hunt for memory --- leaks in an application a developer might want to free all memory --- allocated by Python before exiting from the application. - --- /Bugs and caveats/: The destruction of modules and objects in modules is --- done in arbitrary order; this may cause destructors (@__del__()@ methods) --- to fail when they depend on other objects (even functions) or modules. --- Dynamically loaded extension modules loaded by Python are not unloaded. --- Small amounts of memory allocated by the Python interpreter may not be --- freed (if you find a leak, please report it). Memory tied up in circular --- references between objects is not freed. Some memory allocated by extension --- modules may not be freed. Some extensions may not work properly if their --- initialization routine is called more than once; this can happen if an --- application calls 'initialize' and 'finalize' more than once. --- -{# fun Py_Finalize as finalize - {} -> `()' id #} - -newtype ThreadState = ThreadState (Ptr ThreadState) - --- | Create a new sub-interpreter. This is an (almost) totally separate --- environment for the execution of Python code. In particular, the new --- interpreter has separate, independent versions of all imported modules, --- including the fundamental modules @builtins@, @__main__@ and @sys@. The --- table of loaded modules (@sys.modules@) and the module search path --- (@sys.path@) are also separate. The new environment has no @sys.argv@ --- variable. It has new standard I/O stream file objects @sys.stdin@, --- @sys.stdout@ and @sys.stderr@ (however these refer to the same underlying --- @FILE@ structures in the C library). --- --- The return value points to the first thread state created in the new --- sub-interpreter. This thread state is made in the current thread state. --- Note that no actual thread is created; see the discussion of thread states --- below. If creation of the new interpreter is unsuccessful, 'Nothing' is --- returned; no exception is set since the exception state is stored in the --- current thread state and there may not be a current thread state. (Like --- all other Python/C API computations, the global interpreter lock must be --- held before calling this computation and is still held when it returns; --- however, unlike most other Python/C API computations, there --- needn’t be a current thread state on entry.) --- --- Extension modules are shared between (sub-)interpreters as follows: the --- first time a particular extension is imported, it is initialized normally, --- and a (shallow) copy of its module’s dictionary is squirreled away. --- When the same extension is imported by another (sub-)interpreter, a new --- module is initialized and filled with the contents of this copy; the --- extension’s @init@ procedure is not called. Note that this is --- different from what happens when an extension is imported after the --- interpreter has been completely re-initialized by calling 'finalize' and --- 'initialize'; in that case, the extension’s @init/module/@ --- procedure is called again. --- --- /Bugs and caveats/: Because sub-interpreters (and the main interpreter) --- are part of the same process, the insulation between them isn’t --- perfect — for example, using low-level file operations like --- @os.close()@ they can (accidentally or maliciously) affect each --- other’s open files. Because of the way extensions are shared --- between (sub-)interpreters, some extensions may not work properly; this --- is especially likely when the extension makes use of (static) global --- variables, or when the extension manipulates its module’s --- dictionary after its initialization. It is possible to insert objects --- created in one sub-interpreter into a namespace of another --- sub-interpreter; this should be done with great care to avoid sharing --- user-defined functions, methods, instances or classes between --- sub-interpreters, since import operations executed by such objects may --- affect the wrong (sub-)interpreter’s dictionary of loaded modules. --- (XXX This is a hard-to-fix bug that will be addressed in a future release.) --- --- Also note that the use of this functionality is incompatible with --- extension modules such as PyObjC and ctypes that use the @PyGILState_*()@ --- APIs (and this is inherent in the way the @PyGILState_*()@ procedures --- work). Simple things may work, but confusing behavior will always be near. --- -newInterpreter :: IO (Maybe ThreadState) -newInterpreter = do - ptr <- {# call Py_NewInterpreter as ^ #} - return $ if ptr == nullPtr - then Nothing - else Just $ ThreadState $ castPtr ptr - --- | Destroy the (sub-)interpreter represented by the given thread state. --- The given thread state must be the current thread state. See the --- discussion of thread states below. When the call returns, the current --- thread state is @NULL@. All thread states associated with this --- interpreter are destroyed. (The global interpreter lock must be held --- before calling this computation and is still held when it returns.) --- 'finalize' will destroy all sub-interpreters that haven’t been --- explicitly destroyed at that point. --- -endInterpreter :: ThreadState -> IO () -endInterpreter (ThreadState ptr) = - {# call Py_EndInterpreter as ^ #} $ castPtr ptr - --- | Return the program name set with 'setProgramName', or the default. --- -getProgramName :: IO Text -getProgramName = pyGetProgramName >>= peekTextW - -foreign import ccall safe "hscpython-shim.h Py_GetProgramName" - pyGetProgramName :: IO CWString - --- | This computation should be called before 'initialize' is called for the --- first time, if it is called at all. It tells the interpreter the value of --- the @argv[0]@ argument to the @main@ procedure of the program. This is --- used by 'getPath' and some other computations below to find the Python --- run-time libraries relative to the interpreter executable. The default --- value is @\"python\"@. No code in the Python interpreter will change the --- program name. --- -setProgramName :: Text -> IO () -setProgramName name = withTextW name cSetProgramName - -foreign import ccall safe "hscpython-shim.h hscpython_SetProgramName" - cSetProgramName :: CWString -> IO () - --- | Return the prefix for installed platform-independent files. This is --- derived through a number of complicated rules from the program name set --- with 'setProgramName' and some environment variables; for example, if the --- program name is @\"\/usr\/local\/bin\/python\"@, the prefix is --- @\"\/usr\/local\"@. This corresponds to the @prefix@ variable in the --- top-level Makefile and the /--prefix/ argument to the @configure@ script --- at build time. The value is available to Python code as @sys.prefix@. It --- is only useful on UNIX. See also 'getExecPrefix'. --- -getPrefix :: IO Text -getPrefix = pyGetPrefix >>= peekTextW - -foreign import ccall safe "hscpython-shim.h Py_GetPrefix" - pyGetPrefix :: IO CWString - --- | Return the /exec-prefix/ for installed platform-/dependent/ files. This --- is derived through a number of complicated rules from the program name --- set with setProgramName' and some environment variables; for example, if --- the program name is @\"\/usr\/local\/bin\/python\"@, the exec-prefix is --- @\"\/usr\/local\"@. This corresponds to the @exec_prefix@ variable in the --- top-level Makefile and the /--exec-prefix/ argument to the @configure@ --- script at build time. The value is available to Python code as --- @sys.exec_prefix@. It is only useful on UNIX. --- --- Background: The exec-prefix differs from the prefix when platform --- dependent files (such as executables and shared libraries) are installed --- in a different directory tree. In a typical installation, platform --- dependent files may be installed in the @\/usr\/local\/plat@ subtree while --- platform independent may be installed in @\/usr\/local@. --- --- Generally speaking, a platform is a combination of hardware and software --- families, e.g. Sparc machines running the Solaris 2.x operating system --- are considered the same platform, but Intel machines running Solaris --- 2.x are another platform, and Intel machines running Linux are yet --- another platform. Different major revisions of the same operating system --- generally also form different platforms. Non-UNIX operating systems are a --- different story; the installation strategies on those systems are so --- different that the prefix and exec-prefix are meaningless, and set to the --- empty string. Note that compiled Python bytecode files are platform --- independent (but not independent from the Python version by which they --- were compiled!). --- --- System administrators will know how to configure the @mount@ or @automount@ --- programs to share @\/usr\/local@ between platforms while having --- @\/usr\/local\/plat@ be a different filesystem for each platform. --- -getExecPrefix :: IO Text -getExecPrefix = pyGetExecPrefix >>= peekTextW - -foreign import ccall safe "hscpython-shim.h Py_GetExecPrefix" - pyGetExecPrefix :: IO CWString - --- | Return the full program name of the Python executable; this is computed --- as a side-effect of deriving the default module search path from the --- program name (set by 'setProgramName' above). The value is available to --- Python code as @sys.executable@. --- -getProgramFullPath :: IO Text -getProgramFullPath = pyGetProgramFullPath >>= peekTextW - -foreign import ccall safe "hscpython-shim.h Py_GetProgramFullPath" - pyGetProgramFullPath :: IO CWString - --- | Return the default module search path; this is computed from the --- program name (set by 'setProgramName' above) and some environment --- variables. The returned string consists of a series of directory names --- separated by a platform dependent delimiter character. The delimiter --- character is @\':\'@ on Unix and Mac OS X, @\';\'@ on Windows. The value --- is available to Python code as the list @sys.path@, which may be modified --- to change the future search path for loaded modules. --- -getPath :: IO Text -getPath = pyGetPath >>= peekTextW - -foreign import ccall safe "hscpython-shim.h Py_GetPath" - pyGetPath :: IO CWString - --- | Return the version of this Python interpreter. This is a string that --- looks something like --- --- @ --- \"3.0a5+ (py3k:63103M, May 12 2008, 00:53:55) \\n[GCC 4.2.3]\" --- @ --- --- The first word (up to the first space character) is the current Python --- version; the first three characters are the major and minor version --- separated by a period. The value is available to Python code as --- @sys.version@. --- -{# fun Py_GetVersion as getVersion - {} -> `Text' peekText* #} - --- | Return the platform identifier for the current platform. On Unix, this --- is formed from the “official” name of the operating system, --- converted to lower case, followed by the major revision number; e.g., for --- Solaris 2.x, which is also known as SunOS 5.x, the value is @\"sunos5\"@. --- On Mac OS X, it is @\"darwin\"@. On Windows, it is @\"win\"@. The value --- is available to Python code as @sys.platform@. --- -{# fun Py_GetPlatform as getPlatform - {} -> `Text' peekText* #} - --- | Return the official copyright string for the current Python version, --- for example --- --- @ --- \"Copyright 1991-1995 Stichting Mathematisch Centrum, Amsterdam\" --- @ --- --- The value is available to Python code as @sys.copyright@. --- -{# fun Py_GetCopyright as getCopyright - {} -> `Text' peekText* #} - --- | Return an indication of the compiler used to build the current Python --- version, in square brackets, for example: --- --- @ --- \"[GCC 2.7.2.2]\" --- @ --- --- The value is available to Python code as part of the variable --- @sys.version@. --- -{# fun Py_GetCompiler as getCompiler - {} -> `Text' peekText* #} - --- | Return information about the sequence number and build date and time of --- the current Python interpreter instance, for example --- --- @ --- \"#67, Aug 1 1997, 22:34:28\" --- @ --- --- The value is available to Python code as part of the variable --- @sys.version@. --- -{# fun Py_GetBuildInfo as getBuildInfo - {} -> `Text' peekText* #} - --- | Set @sys.argv@. The first parameter is similar to the result of --- 'getProgName', with the difference that it should refer to the script --- file to be executed rather than the executable hosting the Python --- interpreter. If there isn’t a script that will be run, the first --- parameter can be an empty string. If this function fails to initialize --- @sys.argv@, a fatal condition is signalled using @Py_FatalError()@. --- --- This function also prepends the executed script’s path to --- @sys.path@. If no script is executed (in the case of calling @python -c@ --- or just the interactive interpreter), the empty string is used instead. --- -setArgv :: Text -> [Text] -> IO () -setArgv argv0 argv = - mapWith withTextW (argv0 : argv) $ \textPtrs -> - let argc = fromIntegral $ length textPtrs in - withArray textPtrs $ pySetArgv argc - -foreign import ccall safe "hscpython-shim.h PySys_SetArgv" - pySetArgv :: CInt -> Ptr CWString -> IO () - --- | Return the default “home”, that is, the value set by a --- previous call to 'setPythonHome', or the value of the @PYTHONHOME@ --- environment variable if it is set. --- -getPythonHome :: IO Text -getPythonHome = pyGetPythonHome >>= peekTextW - -foreign import ccall safe "hscpython-shim.h Py_GetPythonHome" - pyGetPythonHome :: IO CWString - --- | Set the default “home” directory, that is, the location --- of the standard Python libraries. The libraries are searched in --- @/home/\/lib\//python version/@ and @/home/\/lib\//python version/@. No --- code in the Python interpreter will change the Python home. --- -setPythonHome :: Text -> IO () -setPythonHome name = withTextW name cSetPythonHome - -foreign import ccall safe "hscpython-shim.h hscpython_SetPythonHome" - cSetPythonHome :: CWString -> IO () diff --git a/CPython/Constants.chs b/CPython/Constants.chs deleted file mode 100644 --- a/CPython/Constants.chs +++ /dev/null @@ -1,60 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Constants - ( none - , true - , false - , isNone - , isTrue - , isFalse - ) where -import CPython.Internal - -#include - --- | The Python @None@ object, denoting lack of value. --- -{# fun hscpython_Py_None as none - {} -> `SomeObject' peekObject* #} - --- | The Python @True@ object. --- -{# fun hscpython_Py_True as true - {} -> `SomeObject' peekObject* #} - --- | The Python @False@ object. --- -{# fun hscpython_Py_False as false - {} -> `SomeObject' peekObject* #} - -{# fun pure hscpython_Py_None as rawNone - {} -> `Ptr ()' id #} - -{# fun pure hscpython_Py_True as rawTrue - {} -> `Ptr ()' id #} - -{# fun pure hscpython_Py_False as rawFalse - {} -> `Ptr ()' id #} - -isNone :: SomeObject -> IO Bool -isNone obj = withObject obj $ \ptr -> return $ ptr == rawNone - -isTrue :: SomeObject -> IO Bool -isTrue obj = withObject obj $ \ptr -> return $ ptr == rawTrue - -isFalse :: SomeObject -> IO Bool -isFalse obj = withObject obj $ \ptr -> return $ ptr == rawFalse diff --git a/CPython/Internal.chs b/CPython/Internal.chs deleted file mode 100644 --- a/CPython/Internal.chs +++ /dev/null @@ -1,268 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE DeriveDataTypeable #-} -module CPython.Internal - ( - -- * FFI support - module Foreign - , module Foreign.C - , cToBool - , cFromBool - , peekText - , peekTextW - , withText - , withTextW - , mapWith - - -- * Fundamental types - , SomeObject (..) - , Type (..) - , Dictionary (..) - , List (..) - , Tuple (..) - - -- * Objects - , Object (..) - , Concrete (..) - , withObject - , peekObject - , peekStaticObject - , stealObject - , incref - , decref - , callObjectRaw - , unsafeCast - - -- * Exceptions - , Exception (..) - , exceptionIf - , checkStatusCode - , checkBoolReturn - , checkIntReturn - - -- * Other classes - -- ** Mapping - , Mapping (..) - , SomeMapping (..) - , unsafeCastToMapping - - -- ** Sequence - , Sequence (..) - , SomeSequence (..) - , unsafeCastToSequence - - -- ** Iterator - , Iterator (..) - , SomeIterator (..) - , unsafeCastToIterator - ) where -import Control.Applicative ((<$>)) -import qualified Control.Exception as E -import qualified Data.Text as T -import Data.Typeable (Typeable) -import Foreign -import Foreign.C - -#include - -cToBool :: CInt -> Bool -cToBool = (/= 0) - -cFromBool :: Bool -> CInt -cFromBool x = if x then 1 else 0 - -peekText :: CString -> IO T.Text -peekText = fmap T.pack . peekCString - -peekTextW :: CWString -> IO T.Text -peekTextW = fmap T.pack . peekCWString - -withText :: T.Text -> (CString -> IO a) -> IO a -withText = withCString . T.unpack - -withTextW :: T.Text -> (CWString -> IO a) -> IO a -withTextW = withCWString . T.unpack - -mapWith :: (a -> (b -> IO c) -> IO c) -> [a] -> ([b] -> IO c) -> IO c -mapWith with' = step [] where - step acc [] io = io acc - step acc (x:xs) io = with' x $ \y -> step (acc ++ [y]) xs io - -data SomeObject = forall a. (Object a) => SomeObject (ForeignPtr a) - -class Object a where - toObject :: a -> SomeObject - fromForeignPtr :: ForeignPtr a -> a - -class Object a => Concrete a where - concreteType :: a -> Type - -instance Object SomeObject where - toObject = id - fromForeignPtr = SomeObject - -newtype Type = Type (ForeignPtr Type) -instance Object Type where - toObject (Type x) = SomeObject x - fromForeignPtr = Type - -newtype Dictionary = Dictionary (ForeignPtr Dictionary) -instance Object Dictionary where - toObject (Dictionary x) = SomeObject x - fromForeignPtr = Dictionary - -newtype List = List (ForeignPtr List) -instance Object List where - toObject (List x) = SomeObject x - fromForeignPtr = List - -newtype Tuple = Tuple (ForeignPtr Tuple) -instance Object Tuple where - toObject (Tuple x) = SomeObject x - fromForeignPtr = Tuple - -withObject :: Object obj => obj -> (Ptr a -> IO b) -> IO b -withObject obj io = case toObject obj of - SomeObject ptr -> withForeignPtr ptr (io . castPtr) - -peekObject :: Object obj => Ptr a -> IO obj -peekObject ptr = E.bracketOnError incPtr decref mkObj where - incPtr = incref ptr >> return ptr - mkObj _ = fromForeignPtr <$> newForeignPtr staticDecref (castPtr ptr) - -peekStaticObject :: Object obj => Ptr a -> IO obj -peekStaticObject ptr = fromForeignPtr <$> newForeignPtr_ (castPtr ptr) - -unsafeStealObject :: Object obj => Ptr a -> IO obj -unsafeStealObject ptr = fromForeignPtr <$> newForeignPtr staticDecref (castPtr ptr) - -stealObject :: Object obj => Ptr a -> IO obj -stealObject ptr = exceptionIf (ptr == nullPtr) >> unsafeStealObject ptr - -{# fun hscpython_Py_INCREF as incref - { castPtr `Ptr a' - } -> `()' id #} - -{# fun hscpython_Py_DECREF as decref - { castPtr `Ptr a' - } -> `()' id #} - -foreign import ccall "hscpython-shim.h &hscpython_Py_DECREF" - staticDecref :: FunPtr (Ptr a -> IO ()) - -{# fun PyObject_CallObject as callObjectRaw - `(Object self, Object args)' => - { withObject* `self' - , withObject* `args' - } -> `SomeObject' stealObject* #} - -unsafeCast :: (Object a, Object b) => a -> b -unsafeCast a = case toObject a of - SomeObject ptr -> fromForeignPtr (castForeignPtr ptr) - -data Exception = Exception - { exceptionType :: SomeObject - , exceptionValue :: SomeObject - , exceptionTraceback :: Maybe SomeObject - } - deriving (Typeable) - -instance Show Exception where - show _ = "" - -instance E.Exception Exception - -exceptionIf :: Bool -> IO () -exceptionIf False = return () -exceptionIf True = - alloca $ \pType -> - alloca $ \pValue -> - alloca $ \pTrace -> do - {# call PyErr_Fetch as ^ #} pType pValue pTrace - {# call PyErr_NormalizeException as ^ #} pType pValue pTrace - eType <- unsafeStealObject =<< peek pType - eValue <- unsafeStealObject =<< peek pValue - eTrace <- maybePeek unsafeStealObject =<< peek pTrace - E.throwIO $ Exception eType eValue eTrace - -checkStatusCode :: CInt -> IO () -checkStatusCode = exceptionIf . (== -1) - -checkBoolReturn :: CInt -> IO Bool -checkBoolReturn x = do - exceptionIf $ x == -1 - return $ x /= 0 - -checkIntReturn :: Integral a => a -> IO Integer -checkIntReturn x = do - exceptionIf $ x == -1 - return $ toInteger x - -data SomeMapping = forall a. (Mapping a) => SomeMapping (ForeignPtr a) - -class Object a => Mapping a where - toMapping :: a -> SomeMapping - -instance Object SomeMapping where - toObject (SomeMapping x) = SomeObject x - fromForeignPtr = SomeMapping - -instance Mapping SomeMapping where - toMapping = id - -unsafeCastToMapping :: Object a => a -> SomeMapping -unsafeCastToMapping x = case toObject x of - SomeObject ptr -> let - ptr' = castForeignPtr ptr :: ForeignPtr SomeMapping - in SomeMapping ptr' - -data SomeSequence = forall a. (Sequence a) => SomeSequence (ForeignPtr a) - -class Object a => Sequence a where - toSequence :: a -> SomeSequence - -instance Object SomeSequence where - toObject (SomeSequence x) = SomeObject x - fromForeignPtr = SomeSequence - -instance Sequence SomeSequence where - toSequence = id - -unsafeCastToSequence :: Object a => a -> SomeSequence -unsafeCastToSequence x = case toObject x of - SomeObject ptr -> let - ptr' = castForeignPtr ptr :: ForeignPtr SomeSequence - in SomeSequence ptr' - -data SomeIterator = forall a. (Iterator a) => SomeIterator (ForeignPtr a) - -class Object a => Iterator a where - toIterator :: a -> SomeIterator - -instance Object SomeIterator where - toObject (SomeIterator x) = SomeObject x - fromForeignPtr = SomeIterator - -instance Iterator SomeIterator where - toIterator = id - -unsafeCastToIterator :: Object a => a -> SomeIterator -unsafeCastToIterator x = case toObject x of - SomeObject ptr -> let - ptr' = castForeignPtr ptr :: ForeignPtr SomeIterator - in SomeIterator ptr' diff --git a/CPython/Protocols/Iterator.chs b/CPython/Protocols/Iterator.chs deleted file mode 100644 --- a/CPython/Protocols/Iterator.chs +++ /dev/null @@ -1,50 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Protocols.Iterator - ( Iterator (..) - , SomeIterator - , castToIterator - , next - ) where -import CPython.Internal - -#include - --- | Attempt to convert an object to a generic 'Iterator'. If the object does --- not implement the iterator protocol, returns 'Nothing'. --- -castToIterator :: Object a => a -> IO (Maybe SomeIterator) -castToIterator obj = - withObject obj $ \objPtr -> do - isIter <- fmap cToBool $ {# call hscpython_PyIter_Check as ^ #} objPtr - return $ if isIter - then Just $ unsafeCastToIterator obj - else Nothing - --- | Return the next value from the iteration, or 'Nothing' if there are no --- remaining items. --- -next :: Iterator iter => iter -> IO (Maybe SomeObject) -next iter = - withObject iter $ \iterPtr -> do - raw <- {# call PyIter_Next as ^ #} iterPtr - if raw == nullPtr - then do - err <- {# call PyErr_Occurred as ^ #} - exceptionIf $ err /= nullPtr - return Nothing - else fmap Just $ stealObject raw diff --git a/CPython/Protocols/Mapping.chs b/CPython/Protocols/Mapping.chs deleted file mode 100644 --- a/CPython/Protocols/Mapping.chs +++ /dev/null @@ -1,88 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Protocols.Mapping - ( Mapping (..) - , SomeMapping - , castToMapping - , getItem - , setItem - , deleteItem - , size - , hasKey - , keys - , values - , items - ) where -import CPython.Internal - -#include - -instance Mapping Dictionary where - toMapping = unsafeCastToMapping - -castToMapping :: Object a => a -> IO (Maybe SomeMapping) -castToMapping obj = - withObject obj $ \objPtr -> do - isMapping <- fmap cToBool $ {# call PyMapping_Check as ^ #} objPtr - return $ if isMapping - then Just $ unsafeCastToMapping obj - else Nothing - -{# fun PyObject_GetItem as getItem - `(Mapping self, Object key)' => - { withObject* `self' - , withObject* `key' - } -> `SomeObject' stealObject* #} - -{# fun PyObject_SetItem as setItem - `(Mapping self, Object key, Object value)' => - { withObject* `self' - , withObject* `key' - , withObject* `value' - } -> `()' checkStatusCode* #} - -{# fun PyObject_DelItem as deleteItem - `(Mapping self, Object key)' => - { withObject* `self' - , withObject* `key' - } -> `()' checkStatusCode* #} - -{# fun PyMapping_Size as size - `Mapping self' => - { withObject* `self' - } -> `Integer' checkIntReturn* #} - -{# fun PyMapping_HasKey as hasKey - `(Mapping self, Object key)' => - { withObject* `self' - , withObject* `key' - } -> `Bool' #} - -{# fun PyMapping_Keys as keys - `Mapping self' => - { withObject* `self' - } -> `List' stealObject* #} - -{# fun PyMapping_Values as values - `Mapping self' => - { withObject* `self' - } -> `List' stealObject* #} - -{# fun PyMapping_Items as items - `Mapping self' => - { withObject* `self' - } -> `List' stealObject* #} diff --git a/CPython/Protocols/Number.chs b/CPython/Protocols/Number.chs deleted file mode 100644 --- a/CPython/Protocols/Number.chs +++ /dev/null @@ -1,299 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE ExistentialQuantification #-} -module CPython.Protocols.Number - ( Number (..) - , SomeNumber - , castToNumber - , add - , subtract - , multiply - , floorDivide - , trueDivide - , remainder - , divmod - , power - , negative - , positive - , absolute - , invert - , shiftL - , shiftR - , and - , xor - , or - , inPlaceAdd - , inPlaceSubtract - , inPlaceMultiply - , inPlaceFloorDivide - , inPlaceTrueDivide - , inPlaceRemainder - , inPlacePower - , inPlaceShiftL - , inPlaceShiftR - , inPlaceAnd - , inPlaceXor - , inPlaceOr - , toInteger - , toFloat - , toBase - ) where -import Prelude hiding (Integer, Float, subtract, and, or, toInteger) -import qualified Prelude as Prelude -import CPython.Internal hiding (xor, shiftR, shiftL) -import CPython.Constants (none) -import CPython.Types.Complex (Complex) -import CPython.Types.Float (Float) -import CPython.Types.Integer (Integer) -import CPython.Types.Unicode (Unicode) -import CPython.Types.Set (Set, FrozenSet) - -#include - -data SomeNumber = forall a. (Number a) => SomeNumber (ForeignPtr a) - -class Object a => Number a where - toNumber :: a -> SomeNumber - -instance Object SomeNumber where - toObject (SomeNumber x) = SomeObject x - fromForeignPtr = SomeNumber - -instance Number SomeNumber where - toNumber = id - -instance Number Integer where - toNumber = unsafeCastToNumber - -instance Number Float where - toNumber = unsafeCastToNumber - -instance Number Complex where - toNumber = unsafeCastToNumber - --- lol wut -instance Number Set where - toNumber = unsafeCastToNumber - -instance Number FrozenSet where - toNumber = unsafeCastToNumber - -unsafeCastToNumber :: Object a => a -> SomeNumber -unsafeCastToNumber x = case toObject x of - SomeObject ptr -> let - ptr' = castForeignPtr ptr :: ForeignPtr SomeNumber - in SomeNumber ptr' - -castToNumber :: Object a => a -> IO (Maybe SomeNumber) -castToNumber obj = - withObject obj $ \objPtr -> do - isNumber <- fmap cToBool $ {# call PyNumber_Check as ^ #} objPtr - return $ if isNumber - then Just $ unsafeCastToNumber obj - else Nothing - -{# fun PyNumber_Add as add - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Subtract as subtract - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Multiply as multiply - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_FloorDivide as floorDivide - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_TrueDivide as trueDivide - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Remainder as remainder - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Divmod as divmod - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -power :: (Number a, Number b, Number c) => a -> b -> Maybe c -> IO SomeNumber -power a b mc = - withObject a $ \aPtr -> - withObject b $ \bPtr -> - maybe none (return . toObject) mc >>= \c -> - withObject c $ \cPtr -> - {# call PyNumber_Power as ^ #} aPtr bPtr cPtr - >>= stealObject - -{# fun PyNumber_Negative as negative - `Number a' => - { withObject* `a' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Positive as positive - `Number a' => - { withObject* `a' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Absolute as absolute - `Number a' => - { withObject* `a' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Invert as invert - `Number a' => - { withObject* `a' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Lshift as shiftL - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Rshift as shiftR - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_And as and - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Xor as xor - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Or as or - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_InPlaceAdd as inPlaceAdd - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_InPlaceSubtract as inPlaceSubtract - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_InPlaceMultiply as inPlaceMultiply - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_InPlaceFloorDivide as inPlaceFloorDivide - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_InPlaceTrueDivide as inPlaceTrueDivide - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_InPlaceRemainder as inPlaceRemainder - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -inPlacePower ::(Number a, Number b, Number c) => a -> b -> Maybe c -> IO SomeNumber -inPlacePower a b mc = - withObject a $ \aPtr -> - withObject b $ \bPtr -> - maybe none (return . toObject) mc >>= \c -> - withObject c $ \cPtr -> - {# call PyNumber_InPlacePower as ^ #} aPtr bPtr cPtr - >>= stealObject - -{# fun PyNumber_InPlaceLshift as inPlaceShiftL - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_InPlaceRshift as inPlaceShiftR - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_InPlaceAnd as inPlaceAnd - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_InPlaceXor as inPlaceXor - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_InPlaceOr as inPlaceOr - `(Number a, Number b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeNumber' stealObject* #} - -{# fun PyNumber_Long as toInteger - `Number a' => - { withObject* `a' - } -> `Integer' stealObject* #} - -{# fun PyNumber_Float as toFloat - `Number a' => - { withObject* `a' - } -> `Float' stealObject* #} - -{# fun PyNumber_ToBase as toBase - `Number a' => - { withObject* `a' - , fromIntegral `Prelude.Integer' - } -> `Unicode' stealObject* #} diff --git a/CPython/Protocols/Object.chs b/CPython/Protocols/Object.chs deleted file mode 100644 --- a/CPython/Protocols/Object.chs +++ /dev/null @@ -1,317 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Protocols.Object - ( Object - , Concrete - , SomeObject - - -- * Types and casting - , getType - , isInstance - , isSubclass - , toObject - , cast - - -- * Attributes - , hasAttribute - , getAttribute - , setAttribute - , deleteAttribute - - -- * Display and debugging - , print - , repr - , ascii - , string - , bytes - - -- * Callables - , callable - , call - , callArgs - , callMethod - , callMethodArgs - - -- * Misc - , Comparison (..) - , richCompare - , toBool - , hash - , dir - , getIterator - ) where -import Prelude hiding (Ordering (..), print) -import qualified Data.Text as T -import System.IO (Handle, hPutStrLn) -import CPython.Internal hiding (toBool) -import qualified CPython.Types.Bytes as B -import qualified CPython.Types.Dictionary as D -import qualified CPython.Types.Tuple as Tuple -import qualified CPython.Types.Unicode as U - -#include - --- | Returns a 'Type' object corresponding to the object type of /self/. On --- failure, throws @SystemError@. This is equivalent to the Python expression --- @type(o)@. --- -{# fun PyObject_Type as getType - `Object self' => - { withObject* `self' - } -> `Type' stealObject* #} - --- | Returns 'True' if /inst/ is an instance of the class /cls/ or a --- subclass of /cls/, or 'False' if not. On error, throws an exception. --- If /cls/ is a type object rather than a class object, 'isInstance' --- returns 'True' if /inst/ is of type /cls/. If /cls/ is a tuple, the check --- will be done against every entry in /cls/. The result will be 'True' when --- at least one of the checks returns 'True', otherwise it will be 'False'. If --- /inst/ is not a class instance and /cls/ is neither a type object, nor a --- class object, nor a tuple, /inst/ must have a @__class__@ attribute ߞ --- the class relationship of the value of that attribute with /cls/ will be --- used to determine the result of this function. --- --- Subclass determination is done in a fairly straightforward way, but --- includes a wrinkle that implementors of extensions to the class system --- may want to be aware of. If A and B are class objects, B is a subclass of --- A if it inherits from A either directly or indirectly. If either is not a --- class object, a more general mechanism is used to determine the class --- relationship of the two objects. When testing if B is a subclass of A, if --- A is B, 'isSubclass' returns 'True'. If A and B are different objects, --- Bߢs @__bases__@ attribute is searched in a depth-first fashion for --- A ߞ the presence of the @__bases__@ attribute is considered --- sufficient for this determination. --- -{# fun PyObject_IsInstance as isInstance - `(Object self, Object cls)' => - { withObject* `self' - , withObject* `cls' - } -> `Bool' checkBoolReturn* #} - --- | Returns 'True' if the class /derived/ is identical to or derived from --- the class /cls/, otherwise returns 'False'. In case of an error, throws --- an exception. If /cls/ is a tuple, the check will be done against every --- entry in /cls/. The result will be 'True' when at least one of the checks --- returns 'True', otherwise it will be 'False'. If either /derived/ or /cls/ --- is not an actual class object (or tuple), this function uses the generic --- algorithm described above. --- -{# fun PyObject_IsSubclass as isSubclass - `(Object derived, Object cls)' => - { withObject* `derived' - , withObject* `cls' - } -> `Bool' checkBoolReturn* #} - --- | Attempt to cast an object to some concrete class. If the object --- isn't an instance of the class or subclass, returns 'Nothing'. --- -cast :: (Object a, Concrete b) => a -> IO (Maybe b) -cast obj = do - let castObj = case toObject obj of - SomeObject ptr -> fromForeignPtr $ castForeignPtr ptr - validCast <- isInstance obj $ concreteType castObj - return $ if validCast - then Just castObj - else Nothing - --- | Returns 'True' if /self/ has an attribute with the given name, and --- 'False' otherwise. This is equivalent to the Python expression --- @hasattr(self, name)@ --- -{# fun PyObject_HasAttr as hasAttribute - `Object self' => - { withObject* `self' - , withObject* `U.Unicode' - } -> `Bool' #} - --- | Retrieve an attribute with the given name from object /self/. Returns --- the attribute value on success, and throws an exception on failure. This --- is the equivalent of the Python expression @self.name@. --- -{# fun PyObject_GetAttr as getAttribute - `Object self' => - { withObject* `self' - , withObject* `U.Unicode' - } -> `SomeObject' stealObject* #} - --- | Set the value of the attribute with the given name, for object /self/, --- to the value /v/. THrows an exception on failure. This is the equivalent --- of the Python statement @self.name = v@. --- -{# fun PyObject_SetAttr as setAttribute - `(Object self, Object v)' => - { withObject* `self' - , withObject* `U.Unicode' - , withObject* `v' - } -> `()' checkStatusCode* #} - --- | Delete an attribute with the given name, for object /self/. Throws an --- exception on failure. This is the equivalent of the Python statement --- @del self.name@. --- -{# fun hscpython_PyObject_DelAttr as deleteAttribute - `Object self' => - { withObject* `self' - , withObject* `U.Unicode' - } -> `()' checkStatusCode* #} - --- | Print @repr(self)@ to a handle. --- -print :: Object self => self -> Handle -> IO () -print obj h = repr obj >>= U.fromUnicode >>= (hPutStrLn h . T.unpack) - --- | Compute a string representation of object /self/, or throw an exception --- on failure. This is the equivalent of the Python expression @repr(self)@. --- -{# fun PyObject_Repr as repr - `Object self' => - { withObject* `self' - } -> `U.Unicode' stealObject* #} - --- \ As 'ascii', compute a string representation of object /self/, but escape --- the non-ASCII characters in the string returned by 'repr' with @\x@, @\u@ --- or @\U@ escapes. This generates a string similar to that returned by --- 'repr' in Python 2. --- -{# fun PyObject_ASCII as ascii - `Object self' => - { withObject* `self' - } -> `U.Unicode' stealObject* #} - --- | Compute a string representation of object /self/, or throw an exception --- on failure. This is the equivalent of the Python expression @str(self)@. --- -{# fun PyObject_Str as string - `Object self' => - { withObject* `self' - } -> `U.Unicode' stealObject* #} - --- | Compute a bytes representation of object /self/, or throw an exception --- on failure. This is equivalent to the Python expression @bytes(self)@. --- -{# fun PyObject_Bytes as bytes - `Object self' => - { withObject* `self' - } -> `B.Bytes' stealObject* #} - --- | Determine if the object /self/ is callable. --- -{# fun PyCallable_Check as callable - `Object self' => - { withObject* `self' - } -> `Bool' checkBoolReturn* #} - --- | Call a callable Python object /self/, with arguments given by the --- tuple and named arguments given by the dictionary. Returns the result of --- the call on success, or throws an exception on failure. This is the --- equivalent of the Python expression @self(*args, **kw)@. --- -call :: Object self => self -> Tuple -> Dictionary -> IO SomeObject -call self args kwargs = - withObject self $ \selfPtr -> - withObject args $ \argsPtr -> - withObject kwargs $ \kwargsPtr -> - {# call PyObject_Call as ^ #} selfPtr argsPtr kwargsPtr - >>= stealObject - --- | Call a callable Python object /self/, with arguments given by the list. --- -callArgs :: Object self => self -> [SomeObject] -> IO SomeObject -callArgs self args = do - args' <- Tuple.toTuple args - D.new >>= call self args' - --- | Call the named method of object /self/, with arguments given by the --- tuple and named arguments given by the dictionary. Returns the result of --- the call on success, or throws an exception on failure. This is the --- equivalent of the Python expression @self.method(args)@. --- -callMethod :: Object self => self -> T.Text -> Tuple -> Dictionary -> IO SomeObject -callMethod self name args kwargs = do - method <- getAttribute self =<< U.toUnicode name - call method args kwargs - --- | Call the named method of object /self/, with arguments given by the --- list. Returns the result of the call on success, or throws an exception --- on failure. This is the equivalent of the Python expression --- @self.method(args)@. --- -callMethodArgs :: Object self => self -> T.Text -> [SomeObject] -> IO SomeObject -callMethodArgs self name args = do - args' <- Tuple.toTuple args - D.new >>= callMethod self name args' - -data Comparison = LT | LE | EQ | NE | GT | GE - deriving (Show) - -{# enum HSCPythonComparisonEnum {} #} - -comparisonToInt :: Comparison -> CInt -comparisonToInt = fromIntegral . fromEnum . enum where - enum LT = HSCPYTHON_LT - enum LE = HSCPYTHON_LE - enum EQ = HSCPYTHON_EQ - enum NE = HSCPYTHON_NE - enum GT = HSCPYTHON_GT - enum GE = HSCPYTHON_GE - --- | Compare the values of /a/ and /b/ using the specified comparison. --- If an exception is raised, throws an exception. --- -{# fun PyObject_RichCompareBool as richCompare - `(Object a, Object b)' => - { withObject* `a' - , withObject* `b' - , comparisonToInt `Comparison' - } -> `Bool' checkBoolReturn* #} - --- | Returns 'True' if the object /self/ is considered to be true, and 'False' --- otherwise. This is equivalent to the Python expression @not not self@. On --- failure, throws an exception. --- -{# fun PyObject_IsTrue as toBool - `Object self' => - { withObject* `self' - } -> `Bool' checkBoolReturn* #} - --- | Compute and return the hash value of an object /self/. On failure, --- throws an exception. This is the equivalent of the Python expression --- @hash(self)@. --- -{# fun PyObject_Hash as hash - `Object self' => - { withObject* `self' - } -> `Integer' checkIntReturn* #} - --- | This is equivalent to the Python expression @dir(self)@, returning a --- (possibly empty) list of strings appropriate for the object argument, --- or throws an exception if there was an error. --- -{# fun PyObject_Dir as dir - `Object self' => - { withObject* `self' - } -> `List' stealObject* #} - --- | This is equivalent to the Python expression @iter(self)@. It returns a --- new iterator for the object argument, or the object itself if the object --- is already an iterator. Throws @TypeError@ if the object cannot be --- iterated. --- -{# fun PyObject_GetIter as getIterator - `Object self' => - { withObject* `self' - } -> `SomeObject' stealObject* #} diff --git a/CPython/Protocols/Sequence.chs b/CPython/Protocols/Sequence.chs deleted file mode 100644 --- a/CPython/Protocols/Sequence.chs +++ /dev/null @@ -1,189 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Protocols.Sequence - ( Sequence (..) - , SomeSequence - , castToSequence - , length - , append - , repeat - , inPlaceAppend - , inPlaceRepeat - , getItem - , setItem - , deleteItem - , getSlice - , setSlice - , deleteSlice - , count - , contains - , index - , toList - , toTuple - , fast - ) where -import Prelude hiding (repeat, length) -import Data.Text (Text) -import CPython.Internal -import CPython.Types.ByteArray (ByteArray) -import CPython.Types.Bytes (Bytes) -import CPython.Types.Unicode (Unicode) - -#include - -instance Sequence ByteArray where - toSequence = unsafeCastToSequence - -instance Sequence Bytes where - toSequence = unsafeCastToSequence - -instance Sequence List where - toSequence = unsafeCastToSequence - -instance Sequence Tuple where - toSequence = unsafeCastToSequence - -instance Sequence Unicode where - toSequence = unsafeCastToSequence - --- | Attempt to convert an object to a generic 'Sequence'. If the object does --- not implement the sequence protocol, returns 'Nothing'. --- -castToSequence :: Object a => a -> IO (Maybe SomeSequence) -castToSequence obj = - withObject obj $ \objPtr -> do - isSequence <- fmap cToBool $ {# call PySequence_Check as ^ #} objPtr - return $ if isSequence - then Just $ unsafeCastToSequence obj - else Nothing - -{# fun PySequence_Size as length - `Sequence self' => - { withObject* `self' - } -> `Integer' checkIntReturn* #} - -{# fun PySequence_Concat as append - `(Sequence a, Sequence b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeSequence' stealObject* #} - -{# fun PySequence_Repeat as repeat - `Sequence a' => - { withObject* `a' - , fromIntegral `Integer' - } -> `a' stealObject* #} - -{# fun PySequence_InPlaceConcat as inPlaceAppend - `(Sequence a, Sequence b)' => - { withObject* `a' - , withObject* `b' - } -> `SomeSequence' stealObject* #} - -{# fun PySequence_InPlaceRepeat as inPlaceRepeat - `Sequence a' => - { withObject* `a' - , fromIntegral `Integer' - } -> `a' stealObject* #} - -{# fun PySequence_GetItem as getItem - `Sequence self' => - { withObject* `self' - , fromIntegral `Integer' - } -> `SomeObject' stealObject* #} - -{# fun PySequence_SetItem as setItem - `(Sequence self, Object v)' => - { withObject* `self' - , fromIntegral `Integer' - , withObject* `v' - } -> `()' checkStatusCode* #} - -{# fun PySequence_DelItem as deleteItem - `Sequence self' => - { withObject* `self' - , fromIntegral `Integer' - } -> `()' checkStatusCode* #} - -{# fun PySequence_GetSlice as getSlice - `Sequence self' => - { withObject* `self' - , fromIntegral `Integer' - , fromIntegral `Integer' - } -> `SomeObject' stealObject* #} - -{# fun PySequence_SetSlice as setSlice - `(Sequence self, Object v)' => - { withObject* `self' - , fromIntegral `Integer' - , fromIntegral `Integer' - , withObject* `v' - } -> `()' checkStatusCode* #} - -{# fun PySequence_DelSlice as deleteSlice - `Sequence self' => - { withObject* `self' - , fromIntegral `Integer' - , fromIntegral `Integer' - } -> `()' checkStatusCode* #} - -{# fun PySequence_Count as count - `(Sequence self, Object v)' => - { withObject* `self' - , withObject* `v' - } -> `Integer' checkIntReturn* #} - -{# fun PySequence_Contains as contains - `(Sequence self, Object v)' => - { withObject* `self' - , withObject* `v' - } -> `Bool' checkBoolReturn* #} - --- | Return the first index /i/ for which @self[i] == v@. This is equivalent --- to the Python expression @self.index(v)@. --- -{# fun PySequence_Index as index - `(Sequence self, Object v)' => - { withObject* `self' - , withObject* `v' - } -> `Integer' checkIntReturn* #} - --- | Return a list object with the same contents as the arbitrary sequence --- /seq/. The returned list is guaranteed to be new. --- -{# fun PySequence_List as toList - `Sequence seq' => - { withObject* `seq' - } -> `List' stealObject* #} - --- | Return a tuple object with the same contents as the arbitrary sequence --- /seq/. If /seq/ is already a tuple, it is re-used rather than copied. --- -{# fun PySequence_Tuple as toTuple - `Sequence seq' => - { withObject* `seq' - } -> `Tuple' stealObject* #} - --- | Returns the sequence /seq/ as a tuple, unless it is already a tuple or --- list, in which case /seq/ is returned. If an error occurs, throws --- @TypeError@ with the given text as the exception text. --- -{# fun PySequence_Fast as fast - `Sequence seq' => - { withObject* `seq' - , withText* `Text' - } -> `SomeSequence' stealObject* #} diff --git a/CPython/Reflection.chs b/CPython/Reflection.chs deleted file mode 100644 --- a/CPython/Reflection.chs +++ /dev/null @@ -1,70 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Reflection - ( getBuiltins - , getLocals - , getGlobals - , getFrame - , getFunctionName - , getFunctionDescription - ) where -import Data.Text (Text) -import CPython.Internal - -#include - --- | Return a 'Dictionary' of the builtins in the current execution frame, --- or the interpreter of the thread state if no frame is currently executing. --- -{# fun PyEval_GetBuiltins as getBuiltins - {} -> `Dictionary' peekObject* #} - --- | Return a 'Dictionary' of the local variables in the current execution --- frame, or 'Nothing' if no frame is currently executing. --- -getLocals :: IO (Maybe Dictionary) -getLocals = {# call PyEval_GetLocals as ^#} >>= maybePeek peekObject - --- | Return a 'Dictionary' of the global variables in the current execution --- frame, or 'Nothing' if no frame is currently executing. --- -getGlobals :: IO (Maybe Dictionary) -getGlobals = {# call PyEval_GetGlobals as ^#} >>= maybePeek peekObject - --- | Return the current thread state's frame, which is 'Nothing' if no frame --- is currently executing. --- -getFrame :: IO (Maybe SomeObject) -getFrame = {# call PyEval_GetFrame as ^#} >>= maybePeek peekObject - --- | Return the name of /func/ if it is a function, class or instance object, --- else the name of /func/'s type. --- -{# fun PyEval_GetFuncName as getFunctionName - `Object func' => - { withObject* `func' - } -> `Text' peekText* #} - --- | Return a description string, depending on the type of func. Return --- values include @\"()\"@ for functions and methods, @\"constructor\"@, --- @\"instance\"@, and @\"object\"@. Concatenated with the result of --- 'getFunctionName', the result will be a description of /func/. --- -{# fun PyEval_GetFuncDesc as getFunctionDescription - `Object func' => - { withObject* `func' - } -> `Text' peekText* #} diff --git a/CPython/System.chs b/CPython/System.chs deleted file mode 100644 --- a/CPython/System.chs +++ /dev/null @@ -1,79 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.System - ( getObject - , setObject - , deleteObject - , resetWarnOptions - , addWarnOption - , setPath - ) where -import Data.Text (Text) -import CPython.Internal - -#include - --- | Return the object /name/ from the @sys@ module, or 'Nothing' if it does --- not exist. --- -getObject :: Text -> IO (Maybe SomeObject) -getObject name = - withText name $ \cstr -> do - raw <- {# call PySys_GetObject as ^ #} cstr - maybePeek peekObject raw - --- getFile - --- | Set /name/ in the @sys@ module to a value. --- -setObject :: Object a => Text -> a -> IO () -setObject name v = - withText name $ \cstr -> - withObject v $ \vPtr -> - {# call PySys_SetObject as ^ #} cstr vPtr - >>= checkStatusCode - --- | Delete /name/ from the @sys@ module. --- -deleteObject :: Text -> IO () -deleteObject name = - withText name $ \cstr -> - {# call PySys_SetObject as ^ #} cstr nullPtr - >>= checkStatusCode - --- | Reset @sys.warnoptions@ to an empty list. --- -{# fun PySys_ResetWarnOptions as resetWarnOptions - {} -> `()' id #} - --- | Add an entry to @sys.warnoptions@. --- -addWarnOption :: Text -> IO () -addWarnOption str = withTextW str pySysAddWarnOption - -foreign import ccall safe "hscpython-shim.h PySys_AddWarnOption" - pySysAddWarnOption :: CWString -> IO () - --- | Set @sys.path@ to a list object of paths found in the parameter, which --- should be a list of paths separated with the platform's search path --- delimiter (@\':\'@ on Unix, @\';\'@ on Windows). --- -setPath :: Text -> IO () -setPath path = withTextW path pySysSetPath - -foreign import ccall safe "hscpython-shim.h PySys_SetPath" - pySysSetPath :: CWString -> IO () diff --git a/CPython/Types.hs b/CPython/Types.hs deleted file mode 100644 --- a/CPython/Types.hs +++ /dev/null @@ -1,116 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -module CPython.Types - ( - -- * Types and classes - ByteArray - , Bytes - , Capsule - , Cell - , Code - , Complex - , Dictionary - , Exception - , CPython.Types.Float.Float - , Function - , InstanceMethod - , CPython.Types.Integer.Integer - , SequenceIterator - , CallableIterator - , List - , Method - , Module - , AnySet - , Set - , FrozenSet - , Slice - , Tuple - , Type - , Unicode - , Reference - , Proxy - - -- * Python 'Type' values - , byteArrayType - , bytesType - , capsuleType - , cellType - , codeType - , complexType - , dictionaryType - , floatType - , functionType - , instanceMethodType - , integerType - , sequenceIteratorType - , callableIteratorType - , listType - , methodType - , moduleType - , setType - , frozenSetType - , sliceType - , tupleType - , typeType - , unicodeType - - -- * Building and parsing values - , toByteArray - , fromByteArray - , toBytes - , fromBytes - , toComplex - , fromComplex - , toFloat - , fromFloat - , CPython.Types.Integer.toInteger - , CPython.Types.Integer.fromInteger - , toList - , iterableToList - , fromList - , toSet - , toFrozenSet - , iterableToSet - , iterableToFrozenSet - , fromSet - , CPython.Types.Tuple.toTuple - , iterableToTuple - , fromTuple - , toUnicode - , fromUnicode - ) where -import CPython.Types.ByteArray -import CPython.Types.Bytes -import CPython.Types.Capsule -import CPython.Types.Cell -import CPython.Types.Code -import CPython.Types.Complex -import CPython.Types.Dictionary -import CPython.Types.Exception -import CPython.Types.Float -import CPython.Types.Function -import CPython.Types.InstanceMethod -import CPython.Types.Integer -import CPython.Types.Iterator -import CPython.Types.List -import CPython.Types.Method -import CPython.Types.Module -import CPython.Types.Set -import CPython.Types.Slice -import CPython.Types.Tuple -import CPython.Types.Type -import CPython.Types.Unicode -import CPython.Types.WeakReference diff --git a/CPython/Types/ByteArray.chs b/CPython/Types/ByteArray.chs deleted file mode 100644 --- a/CPython/Types/ByteArray.chs +++ /dev/null @@ -1,79 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.ByteArray - ( ByteArray - , byteArrayType - , toByteArray - , fromByteArray - , fromObject - , append - , length - , resize - ) where -import Prelude hiding (length) -import qualified Data.ByteString as B -import qualified Data.ByteString.Unsafe as B -import CPython.Internal - -#include - -newtype ByteArray = ByteArray (ForeignPtr ByteArray) - -instance Object ByteArray where - toObject (ByteArray x) = SomeObject x - fromForeignPtr = ByteArray - -instance Concrete ByteArray where - concreteType _ = byteArrayType - -{# fun pure hscpython_PyByteArray_Type as byteArrayType - {} -> `Type' peekStaticObject* #} - -toByteArray :: B.ByteString -> IO ByteArray -toByteArray bytes = let - mkByteArray = {# call PyByteArray_FromStringAndSize as ^ #} - in B.unsafeUseAsCStringLen bytes $ \(cstr, len) -> - stealObject =<< mkByteArray cstr (fromIntegral len) - -fromByteArray :: ByteArray -> IO B.ByteString -fromByteArray py = - withObject py $ \pyPtr -> do - size' <- {# call PyByteArray_Size as ^ #} pyPtr - bytes <- {# call PyByteArray_AsString as ^ #} pyPtr - B.packCStringLen (bytes, fromIntegral size') - --- | Create a new byte array from any object which implements the buffer --- protocol. --- -{# fun PyByteArray_FromObject as fromObject - `Object self ' => - { withObject* `self' - } -> `ByteArray' stealObject* #} - -{# fun PyByteArray_Concat as append - { withObject* `ByteArray' - , withObject* `ByteArray' - } -> `ByteArray' stealObject* #} - -{# fun PyByteArray_Size as length - { withObject* `ByteArray' - } -> `Integer' checkIntReturn* #} - -{# fun PyByteArray_Resize as resize - { withObject* `ByteArray' - , fromIntegral `Integer' - } -> `()' checkStatusCode* #} diff --git a/CPython/Types/Bytes.chs b/CPython/Types/Bytes.chs deleted file mode 100644 --- a/CPython/Types/Bytes.chs +++ /dev/null @@ -1,84 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Bytes - ( Bytes - , bytesType - , toBytes - , fromBytes - , fromObject - , length - , append - ) where -import Prelude hiding (length) -import qualified Data.ByteString as B -import qualified Data.ByteString.Unsafe as B -import CPython.Internal - -#include - -newtype Bytes = Bytes (ForeignPtr Bytes) - -instance Object Bytes where - toObject (Bytes x) = SomeObject x - fromForeignPtr = Bytes - -instance Concrete Bytes where - concreteType _ = bytesType - -{# fun pure hscpython_PyBytes_Type as bytesType - {} -> `Type' peekStaticObject* #} - -toBytes :: B.ByteString -> IO Bytes -toBytes bytes = let - mkBytes = {# call PyBytes_FromStringAndSize as ^ #} - in B.unsafeUseAsCStringLen bytes $ \(cstr, len) -> - stealObject =<< mkBytes cstr (fromIntegral len) - -fromBytes :: Bytes -> IO B.ByteString -fromBytes py = - alloca $ \bytesPtr -> - alloca $ \lenPtr -> - withObject py $ \pyPtr -> do - {# call PyBytes_AsStringAndSize as ^ #} pyPtr bytesPtr lenPtr - >>= checkStatusCode - bytes <- peek bytesPtr - len <- peek lenPtr - B.packCStringLen (bytes, fromIntegral len) - --- | Create a new byte string from any object which implements the buffer --- protocol. --- -{# fun PyBytes_FromObject as fromObject - `Object self ' => - { withObject* `self' - } -> `Bytes' stealObject* #} - -{# fun PyBytes_Size as length - { withObject* `Bytes' - } -> `Integer' checkIntReturn* #} - -append :: Bytes -> Bytes -> IO Bytes -append self next = - alloca $ \tempPtr -> - withObject self $ \selfPtr -> do - incref selfPtr - poke tempPtr selfPtr - withObject next $ \nextPtr -> do - {# call PyBytes_Concat as ^ #} tempPtr nextPtr - newSelf <- peek tempPtr - stealObject newSelf - diff --git a/CPython/Types/Capsule.chs b/CPython/Types/Capsule.chs deleted file mode 100644 --- a/CPython/Types/Capsule.chs +++ /dev/null @@ -1,155 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Capsule - ( Capsule - , capsuleType - --, new - , getPointer - --, getDestructor - , getContext - , getName - , importNamed - , isValid - , setPointer - --, setDestructor - , setContext - --, setName - ) where -import Data.Text (Text) -import CPython.Internal hiding (new) - -#include - --- type Destructor = Ptr () -> IO () -newtype Capsule = Capsule (ForeignPtr Capsule) - -instance Object Capsule where - toObject (Capsule x) = SomeObject x - fromForeignPtr = Capsule - -instance Concrete Capsule where - concreteType _ = capsuleType - -{# fun pure hscpython_PyCapsule_Type as capsuleType - {} -> `Type' peekStaticObject* #} - --- new :: Ptr () -> Maybe Text -> Destructor -> IO Capsule --- new = undefined - --- | Retrieve the pointer stored in the capsule. On failure, throws an --- exception. --- --- The name parameter must compare exactly to the name stored in the capsule. --- If the name stored in the capsule is 'Nothing', the name passed in must --- also be 'Nothing'. Python uses the C function strcmp() to compare capsule --- names. --- -getPointer :: Capsule -> Maybe Text -> IO (Ptr ()) -getPointer py name = - withObject py $ \pyPtr -> - maybeWith withText name $ \namePtr -> - {# call PyCapsule_GetPointer as ^ #} pyPtr namePtr - --- getDestructor :: Capsule -> IO (Maybe Destructor) --- getDestructor = undefined - --- | Return the current context stored in the capsule, which might be @NULL@. --- -getContext :: Capsule -> IO (Ptr ()) -getContext py = - withObject py $ \pyPtr -> do - {# call PyErr_Clear as ^ #} - ptr <- {# call PyCapsule_GetContext as ^ #} pyPtr - if ptr /= nullPtr - then return ptr - else do - exc <- {# call PyErr_Occurred as ^ #} - exceptionIf $ exc /= nullPtr - return ptr - --- | Return the current name stored in the capsule, which might be 'Nothing'. --- -getName :: Capsule -> IO (Maybe Text) -getName py = - withObject py $ \pyPtr -> do - {# call PyErr_Clear as ^ #} - ptr <- {# call PyCapsule_GetName as ^ #} pyPtr - if ptr /= nullPtr - then Just `fmap` peekText ptr - else do - exc <- {# call PyErr_Occurred as ^ #} - exceptionIf $ exc /= nullPtr - return Nothing - --- | Import a pointer to a C object from a capsule attribute in a module. --- The name parameter should specify the full name to the attribute, as in --- @\"module.attribute\"@. The name stored in the capsule must match this --- string exactly. If the second parameter is 'False', import the module --- without blocking (using @PyImport_ImportModuleNoBlock()@). Otherwise, --- imports the module conventionally (using @PyImport_ImportModule()@). --- --- Return the capsule’s internal pointer on success. On failure, throw --- an exception. If the module could not be imported, and if importing in --- non-blocking mode, returns 'Nothing'. --- -importNamed :: Text -> Bool -> IO (Maybe (Ptr ())) -importNamed name block = - withText name $ \namePtr -> - let noBlock = cFromBool (not block) in do - {# call PyErr_Clear as ^ #} - ptr <- {# call PyCapsule_Import as ^ #} namePtr noBlock - if ptr /= nullPtr - then return $ Just ptr - else do - exc <- {# call PyErr_Occurred as ^ #} - exceptionIf $ exc /= nullPtr - return Nothing - --- | Determines whether or not a capsule is valid. A valid capsule's type is --- 'capsuleType', has a non-NULL pointer stored in it, and its internal name --- matches the name parameter. (See 'getPointer' for information on how --- capsule names are compared.) --- --- In other words, if 'isValid' returns 'True', calls to any of the --- accessors (any function starting with @get@) are guaranteed to succeed. --- -isValid :: Capsule -> Maybe Text -> IO Bool -isValid py name = - withObject py $ \pyPtr -> - maybeWith withText name $ \namePtr -> - {# call PyCapsule_IsValid as ^ #} pyPtr namePtr - >>= checkBoolReturn - --- | Set the void pointer inside the capsule. The pointer may not be @NULL@. --- -{# fun PyCapsule_SetPointer as setPointer - { withObject* `Capsule' - , id `Ptr ()' - } -> `()' checkStatusCode* #} - --- setDestructor :: Capsule -> Maybe Destructor -> IO () --- setDestructor = undefined - --- | Set the context pointer inside the capsule. --- -{# fun PyCapsule_SetContext as setContext - { withObject* `Capsule' - , id `Ptr ()' - } -> `()' checkStatusCode* #} - --- setName :: Capsule -> Maybe Text -> IO () --- setName = undefined diff --git a/CPython/Types/Cell.chs b/CPython/Types/Cell.chs deleted file mode 100644 --- a/CPython/Types/Cell.chs +++ /dev/null @@ -1,64 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Cell - ( Cell - , cellType - , new - , get - , set - ) where -import CPython.Internal hiding (new) - -#include - -newtype Cell = Cell (ForeignPtr Cell) - -instance Object Cell where - toObject (Cell x) = SomeObject x - fromForeignPtr = Cell - -instance Concrete Cell where - concreteType _ = cellType - -{# fun pure hscpython_PyCell_Type as cellType - {} -> `Type' peekStaticObject* #} - --- | Create and return a new cell containing the value /obj/. --- -new :: Object obj => Maybe obj -> IO Cell -new obj = - maybeWith withObject obj $ \objPtr -> - {# call PyCell_New as ^ #} objPtr - >>= stealObject - --- | Return the contents of a cell. --- -get :: Cell -> IO (Maybe SomeObject) -get cell = - withObject cell $ \cellPtr -> - {# call PyCell_Get as ^ #} cellPtr - >>= maybePeek stealObject - --- | Set the contents of a cell to /obj/. This releases the reference to any --- current content of the cell. --- -set :: Object obj => Cell -> Maybe obj -> IO () -set cell obj = - withObject cell $ \cellPtr -> - maybeWith withObject obj $ \objPtr -> - {# call PyCell_Set as ^ #} cellPtr objPtr - >>= checkStatusCode diff --git a/CPython/Types/Code.chs b/CPython/Types/Code.chs deleted file mode 100644 --- a/CPython/Types/Code.chs +++ /dev/null @@ -1,35 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Code - ( Code - , codeType - ) where -import CPython.Internal - -#include - -newtype Code = Code (ForeignPtr Code) - -instance Object Code where - toObject (Code x) = SomeObject x - fromForeignPtr = Code - -instance Concrete Code where - concreteType _ = codeType - -{# fun pure hscpython_PyCode_Type as codeType - {} -> `Type' peekStaticObject* #} diff --git a/CPython/Types/Complex.chs b/CPython/Types/Complex.chs deleted file mode 100644 --- a/CPython/Types/Complex.chs +++ /dev/null @@ -1,50 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Complex - ( Complex - , complexType - , toComplex - , fromComplex - ) where -import qualified Data.Complex as C -import CPython.Internal - -#include - -newtype Complex = Complex (ForeignPtr Complex) - -instance Object Complex where - toObject (Complex x) = SomeObject x - fromForeignPtr = Complex - -instance Concrete Complex where - concreteType _ = complexType - -{# fun pure hscpython_PyComplex_Type as complexType - {} -> `Type' peekStaticObject* #} - -toComplex :: C.Complex Double -> IO Complex -toComplex x = raw >>= stealObject where - real = realToFrac $ C.realPart x - imag = realToFrac $ C.imagPart x - raw = {# call PyComplex_FromDoubles as ^ #} real imag - -fromComplex :: Complex -> IO (C.Complex Double) -fromComplex py = withObject py $ \pyPtr -> do - real <- {# call PyComplex_RealAsDouble as ^ #} pyPtr - imag <- {# call PyComplex_ImagAsDouble as ^ #} pyPtr - return $ realToFrac real C.:+ realToFrac imag diff --git a/CPython/Types/Dictionary.chs b/CPython/Types/Dictionary.chs deleted file mode 100644 --- a/CPython/Types/Dictionary.chs +++ /dev/null @@ -1,183 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Dictionary - ( Dictionary - , dictionaryType - , new - , clear - , contains - , copy - , getItem - , setItem - , deleteItem - , items - , keys - , values - , size - , merge - , update - , mergeFromSeq2 - ) where -import CPython.Internal hiding (new) - -#include - -instance Concrete Dictionary where - concreteType _ = dictionaryType - -{# fun pure hscpython_PyDict_Type as dictionaryType - {} -> `Type' peekStaticObject* #} - -{# fun PyDict_New as new - {} -> `Dictionary' stealObject* #} - --- newProxy - --- | Empty an existing dictionary of all key-value pairs. --- -{# fun PyDict_Clear as clear - { withObject* `Dictionary' - } -> `()' id #} - --- | Determine if a dictionary contains /key/. If an item in the dictionary --- matches /key/, return 'True', otherwise return 'False'. On error, throws --- an exception. This is equivalent to the Python expression @key in d@. --- -{# fun PyDict_Contains as contains - `Object key' => - { withObject* `Dictionary' - , withObject* `key' - } -> `Bool' checkBoolReturn* #} - --- | Return a new dictionary that contains the same key-value pairs as the --- old dictionary. --- -{# fun PyDict_Copy as copy - { withObject* `Dictionary' - } -> `Dictionary' stealObject* #} - --- | Return the object from a dictionary which has a key /key/. Return --- 'Nothing' if the key is not present. --- -getItem :: Object key => Dictionary -> key -> IO (Maybe SomeObject) -getItem dict key = - withObject dict $ \dict' -> - withObject key $ \key' -> do - {# call PyErr_Clear as ^ #} - raw <- {# call PyDict_GetItemWithError as ^ #} dict' key' - if raw /= nullPtr - then Just `fmap` peekObject raw - else do - exc <- {# call PyErr_Occurred as ^ #} - exceptionIf $ exc /= nullPtr - return Nothing - --- getItemString - --- | Inserts /value/ into a dictionary with a key of /key/. /key/ must be --- hashable; if it isn’t, throws @TypeError@. --- -{# fun PyDict_SetItem as setItem - `(Object key, Object value)' => - { withObject* `Dictionary' - , withObject* `key' - , withObject* `value' - } -> `()' checkStatusCode* #} - --- setItemString - --- | Remove the entry in a dictionary with key /key/. /key/ must be hashable; --- if it isn’t, throws @TypeError@. --- -{# fun PyDict_DelItem as deleteItem - `Object key' => - { withObject* `Dictionary' - , withObject* `key' - } -> `()' checkStatusCode* #} - --- deleteItemString - --- | Return a 'List' containing all the items in the dictionary, as in --- the Python method @dict.items()@. --- -{# fun PyDict_Items as items - { withObject* `Dictionary' - } -> `List' stealObject* #} - --- | Return a 'List' containing all the keys in the dictionary, as in --- the Python method @dict.keys()@. --- -{# fun PyDict_Keys as keys - { withObject* `Dictionary' - } -> `List' stealObject* #} - --- | Return a 'List' containing all the values in the dictionary, as in --- the Python method @dict.values()@. --- -{# fun PyDict_Values as values - { withObject* `Dictionary' - } -> `List' stealObject* #} - --- | Return the number of items in the dictionary. This is equivalent to --- @len(d)@. -{# fun PyDict_Size as size - { withObject* `Dictionary' - } -> `Integer' checkIntReturn* #} - --- next - --- | Iterate over mapping object /b/ adding key-value pairs to a dictionary. --- /b/ may be a dictionary, or any object supporting 'keys' and 'getItem'. --- If the third parameter is 'True', existing pairs in will be replaced if a --- matching key is found in /b/, otherwise pairs will only be added if there --- is not already a matching key. --- -{# fun PyDict_Merge as merge - `Mapping b' => - { withObject* `Dictionary' - , withObject* `b' - , `Bool' - } -> `()' checkStatusCode* #} - --- | This is the same as @(\\a b -> 'merge' a b True)@ in Haskell, or --- @a.update(b)@ in Python. --- -{# fun PyDict_Update as update - `Mapping b' => - { withObject* `Dictionary' - , withObject* `b' - } -> `()' checkStatusCode* #} - --- | Update or merge into a dictionary, from the key-value pairs in /seq2/. --- /seq2/ must be an iterable object producing iterable objects of length 2, --- viewed as key-value pairs. In case of duplicate keys, the last wins if --- the third parameter is 'True', otherwise the first wins. Equivalent --- Python: --- --- @ --- def mergeFromSeq2(a, seq2, override): --- for key, value in seq2: --- if override or key not in a: --- a[key] = value --- @ --- -{# fun PyDict_MergeFromSeq2 as mergeFromSeq2 - `Object seq2' => - { withObject* `Dictionary' - , withObject* `seq2' - , `Bool' - } -> `()' checkStatusCode* #} diff --git a/CPython/Types/Exception.chs b/CPython/Types/Exception.chs deleted file mode 100644 --- a/CPython/Types/Exception.chs +++ /dev/null @@ -1,25 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Exception - ( Exception - , exceptionType - , exceptionValue - , exceptionTraceback - ) where -import CPython.Internal - -#include diff --git a/CPython/Types/Float.chs b/CPython/Types/Float.chs deleted file mode 100644 --- a/CPython/Types/Float.chs +++ /dev/null @@ -1,46 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Float - ( Float - , floatType - , toFloat - , fromFloat - ) where -import Prelude hiding (Float) -import CPython.Internal - -#include - -newtype Float = Float (ForeignPtr Float) - -instance Object Float where - toObject (Float x) = SomeObject x - fromForeignPtr = Float - -instance Concrete Float where - concreteType _ = floatType - -{# fun pure hscpython_PyFloat_Type as floatType - {} -> `Type' peekStaticObject* #} - -{# fun PyFloat_FromDouble as toFloat - { realToFrac `Double' - } -> `Float' stealObject* #} - -{# fun PyFloat_AsDouble as fromFloat - { withObject* `Float' - } -> `Double' realToFrac #} diff --git a/CPython/Types/Function.chs b/CPython/Types/Function.chs deleted file mode 100644 --- a/CPython/Types/Function.chs +++ /dev/null @@ -1,130 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Function - ( Function - , functionType - , new - , getCode - , getGlobals - , getModule - , getDefaults - , setDefaults - , getClosure - , setClosure - , getAnnotations - , setAnnotations - ) where -import CPython.Internal hiding (new) -import CPython.Types.Code (Code) -import qualified CPython.Constants as Const - -#include - -newtype Function = Function (ForeignPtr Function) - -instance Object Function where - toObject (Function x) = SomeObject x - fromForeignPtr = Function - -instance Concrete Function where - concreteType _ = functionType - -{# fun pure hscpython_PyFunction_Type as functionType - {} -> `Type' peekStaticObject* #} - --- | Return a new function associated with the given code object. The second --- parameter will be used as the globals accessible to the function. --- --- The function's docstring, name, and @__module__@ are retrieved from the --- code object. The parameter defaults and closure are set to 'Nothing'. --- -{# fun PyFunction_New as new - { withObject* `Code' - , withObject* `Dictionary' - } -> `Function' stealObject* #} - --- | Return the code object associated with a function. --- -{# fun PyFunction_GetCode as getCode - { withObject* `Function' - } -> `Code' peekObject* #} - --- | Return the globals dictionary associated with a function. --- -{# fun PyFunction_GetGlobals as getGlobals - { withObject* `Function' - } -> `Dictionary' peekObject* #} - --- | Return the @__module__@ attribute of a function. This is normally --- a 'Unicode' containing the module name, but can be set to any other --- object by Python code. --- -{# fun PyFunction_GetModule as getModule - { withObject* `Function' - } -> `SomeObject' peekObject* #} - -withNullableObject :: Object obj => Maybe obj -> (Ptr a -> IO b) -> IO b -withNullableObject Nothing io = do - none <- Const.none - withObject none io -withNullableObject (Just obj) io = withObject obj io - -peekNullableObject :: Object obj => Ptr a -> IO (Maybe obj) -peekNullableObject = maybePeek peekObject - --- | Return the default parameter values for a function. This can be a tuple --- or 'Nothing'. --- -{# fun PyFunction_GetDefaults as getDefaults - { withObject* `Function' - } -> `Maybe Tuple' peekNullableObject* #} - --- | Set the default values for a function. --- -{# fun PyFunction_SetDefaults as setDefaults - { withObject* `Function' - , withNullableObject* `Maybe Tuple' - } -> `()' checkStatusCode* #} - --- | Return the closure associated with a function. This can be 'Nothing', --- or a tuple of 'Cell's. --- -{# fun PyFunction_GetClosure as getClosure - { withObject* `Function' - } -> `Maybe Tuple' peekNullableObject* #} - --- | Set the closure associated with a function. The tuple should contain --- 'Cell's. --- -{# fun PyFunction_SetClosure as setClosure - { withObject* `Function' - , withNullableObject* `Maybe Tuple' - } -> `()' checkStatusCode* #} - --- | Return the annotations for a function. This can be a mutable dictionary, --- or 'Nothing'. --- -{# fun PyFunction_GetAnnotations as getAnnotations - { withObject* `Function' - } -> `Maybe Dictionary' peekNullableObject* #} - --- | Set the annotations for a function object. --- -{# fun PyFunction_SetAnnotations as setAnnotations - { withObject* `Function' - , withNullableObject* `Maybe Dictionary' - } -> `()' checkStatusCode* #} diff --git a/CPython/Types/InstanceMethod.chs b/CPython/Types/InstanceMethod.chs deleted file mode 100644 --- a/CPython/Types/InstanceMethod.chs +++ /dev/null @@ -1,46 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.InstanceMethod - ( InstanceMethod - , instanceMethodType - , new - , function - ) where -import CPython.Internal hiding (new) - -#include - -newtype InstanceMethod = InstanceMethod (ForeignPtr InstanceMethod) - -instance Object InstanceMethod where - toObject (InstanceMethod x) = SomeObject x - fromForeignPtr = InstanceMethod - -instance Concrete InstanceMethod where - concreteType _ = instanceMethodType - -{# fun pure hscpython_PyInstanceMethod_Type as instanceMethodType - {} -> `Type' peekStaticObject* #} - -{# fun PyInstanceMethod_New as new - `Object func' => - { withObject* `func' - } -> `InstanceMethod' stealObject* #} - -{# fun PyInstanceMethod_Function as function - { withObject* `InstanceMethod' - } -> `SomeObject' peekObject* #} diff --git a/CPython/Types/Integer.chs b/CPython/Types/Integer.chs deleted file mode 100644 --- a/CPython/Types/Integer.chs +++ /dev/null @@ -1,63 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Integer - ( Integer - , integerType - , toInteger - , fromInteger - ) where -import Prelude hiding (Integer, toInteger, fromInteger) -import qualified Prelude as Prelude -import qualified Data.Text as T -import CPython.Internal -import qualified CPython.Types.Unicode as U -import qualified CPython.Protocols.Object as O - -#include - -newtype Integer = Integer (ForeignPtr Integer) - -instance Object Integer where - toObject (Integer x) = SomeObject x - fromForeignPtr = Integer - -instance Concrete Integer where - concreteType _ = integerType - -{# fun pure hscpython_PyLong_Type as integerType - {} -> `Type' peekStaticObject* #} - -toInteger :: Prelude.Integer -> IO Integer -toInteger int = do - let longlong = fromIntegral int - let [_, min', max'] = [longlong, minBound, maxBound] - stealObject =<< if Prelude.toInteger min' < int && int < Prelude.toInteger max' - then {# call PyLong_FromLongLong as ^ #} longlong - else withCString (show int) $ \cstr -> - {# call PyLong_FromString as ^ #} cstr nullPtr 10 - -fromInteger :: Integer -> IO Prelude.Integer -fromInteger py = do - (long, overflow) <- (withObject py $ \pyPtr -> - alloca $ \overflowPtr -> do - poke overflowPtr 0 - long <- {# call PyLong_AsLongAndOverflow as ^ #} pyPtr overflowPtr - overflow <- peek overflowPtr - return (long, overflow)) - if overflow == 0 - then return $ Prelude.toInteger long - else fmap (read . T.unpack) $ U.fromUnicode =<< O.string py diff --git a/CPython/Types/Iterator.chs b/CPython/Types/Iterator.chs deleted file mode 100644 --- a/CPython/Types/Iterator.chs +++ /dev/null @@ -1,78 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Iterator - ( SequenceIterator - , sequenceIteratorType - , sequenceIteratorNew - - , CallableIterator - , callableIteratorType - , callableIteratorNew - ) where -import CPython.Internal - -#include - -newtype SequenceIterator = SequenceIterator (ForeignPtr SequenceIterator) - -instance Iterator SequenceIterator where - toIterator = unsafeCastToIterator - -instance Object SequenceIterator where - toObject (SequenceIterator x) = SomeObject x - fromForeignPtr = SequenceIterator - -instance Concrete SequenceIterator where - concreteType _ = sequenceIteratorType - -newtype CallableIterator = CallableIterator (ForeignPtr CallableIterator) - -instance Iterator CallableIterator where - toIterator = unsafeCastToIterator - -instance Object CallableIterator where - toObject (CallableIterator x) = SomeObject x - fromForeignPtr = CallableIterator - -instance Concrete CallableIterator where - concreteType _ = callableIteratorType - -{# fun pure hscpython_PySeqIter_Type as sequenceIteratorType - {} -> `Type' peekStaticObject* #} - -{# fun pure hscpython_PyCallIter_Type as callableIteratorType - {} -> `Type' peekStaticObject* #} - --- | Return an 'Iterator' that works with a general sequence object, /seq/. --- The iteration ends when the sequence raises @IndexError@ for the --- subscripting operation. --- -{# fun PySeqIter_New as sequenceIteratorNew - `Sequence seq' => - { withObject* `seq' - } -> `SequenceIterator' stealObject* #} - --- | Return a new 'Iterator'. The first parameter, /callable/, can be any --- Python callable object that can be called with no parameters; each call --- to it should return the next item in the iteration. When /callable/ --- returns a value equal to /sentinel/, the iteration will be terminated. --- -{# fun PyCallIter_New as callableIteratorNew - `(Object callable, Object sentinel)' => - { withObject* `callable' - , withObject* `sentinel' - } -> `CallableIterator' stealObject* #} diff --git a/CPython/Types/List.chs b/CPython/Types/List.chs deleted file mode 100644 --- a/CPython/Types/List.chs +++ /dev/null @@ -1,160 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.List - ( List - , listType - , toList - , iterableToList - , fromList - , length - , getItem - , setItem - , insert - , append - , getSlice - , setSlice - , sort - , reverse - , toTuple - ) where -import Prelude hiding (reverse, length) -import CPython.Internal hiding (new) -import qualified CPython.Types.Tuple as T - -#include - -instance Concrete List where - concreteType _ = listType - -{# fun pure hscpython_PyList_Type as listType - {} -> `Type' peekStaticObject* #} - -toList :: [SomeObject] -> IO List -toList xs = - mapWith withObject xs $ \ptrs -> - withArrayLen ptrs $ \count array -> - {# call hscpython_poke_list #} (fromIntegral count) array - >>= stealObject - --- | Convert any object implementing the iterator protocol to a 'List'. --- -iterableToList :: Object iter => iter -> IO List -iterableToList iter = do - raw <- callObjectRaw listType =<< T.toTuple [toObject iter] - return $ unsafeCast raw - -fromList :: List -> IO [SomeObject] -fromList py = - withObject py $ \pyPtr -> - ({# call PyList_Size as ^ #} pyPtr >>=) $ \size -> - let size' = fromIntegral size :: Int in - withArray (replicate size' nullPtr) $ \ptrs -> - {# call hscpython_peek_list #} pyPtr size ptrs >> - peekArray size' ptrs >>= mapM peekObject - -{# fun PyList_Size as length - { withObject* `List' - } -> `Integer' checkIntReturn* #} - --- | Returns the object at a given position in the list. The position must be --- positive; indexing from the end of the list is not supported. If the --- position is out of bounds, throws an @IndexError@ exception. --- -{# fun PyList_GetItem as getItem - { withObject* `List' - , fromIntegral `Integer' - } -> `SomeObject' peekObject* #} - --- | Set the item at a given index. --- -setItem :: Object o => List -> Integer -> o -> IO () -setItem self index x = - withObject self $ \selfPtr -> - withObject x $ \xPtr -> do - incref xPtr - {# call PyList_SetItem as ^ #} selfPtr (fromIntegral index) xPtr - >>= checkStatusCode - --- | Inserts /item/ into the list in front of the given index. Throws an --- exception if unsuccessful. Analogous to @list.insert(index, item)@. --- -{# fun PyList_Insert as insert - `Object item' => - { withObject* `List' - , fromIntegral `Integer' - , withObject* `item' - } -> `()' checkStatusCode* #} - --- | Append /item/ to the end of th list. Throws an exception if unsuccessful. --- Analogous to @list.append(item)@. --- -{# fun PyList_Append as append - `Object item' => - { withObject* `List' - , withObject* `item' - } -> `()' checkStatusCode* #} - --- | Return a list of the objects in list containing the objects between --- the given indexes. Throws an exception if unsuccessful. Analogous to --- @list[low:high]@. Negative indices, as when slicing from Python, are not --- supported. --- -{# fun PyList_GetSlice as getSlice - { withObject* `List' - , fromIntegral `Integer' - , fromIntegral `Integer' - } -> `List' stealObject* #} - --- | Sets the slice of a list between /low/ and /high/ to the contents of --- a replacement list. Analogous to @list[low:high] = replacement@. The --- replacement may be 'Nothing', indicating the assignment of an empty list --- (slice deletion). Negative indices, as when slicing from Python, are not --- supported. --- -setSlice - :: List - -> Integer -- ^ Low - -> Integer -- ^ High - -> Maybe List -- ^ Replacement - -> IO () -setSlice self low high items = let - low' = fromIntegral low - high' = fromIntegral high in - withObject self $ \selfPtr -> - maybeWith withObject items $ \itemsPtr -> do - {# call PyList_SetSlice as ^ #} selfPtr low' high' itemsPtr - >>= checkStatusCode - --- | Sort the items of a list in place. This is equivalent to @list.sort()@. --- -{# fun PyList_Sort as sort - { withObject* `List' - } -> `()' checkStatusCode* #} - --- | Reverses the items of a list in place. This is equivalent to --- @list.reverse()@. --- -{# fun PyList_Reverse as reverse - { withObject* `List' - } -> `()' checkStatusCode* #} - --- | Return a new 'Tuple' containing the contents of a list; equivalent to --- @tuple(list)@. --- -{# fun PyList_AsTuple as toTuple - { withObject* `List' - } -> `Tuple' stealObject* #} diff --git a/CPython/Types/Method.chs b/CPython/Types/Method.chs deleted file mode 100644 --- a/CPython/Types/Method.chs +++ /dev/null @@ -1,52 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Method - ( Method - , methodType - , new - , function - , self - ) where -import CPython.Internal hiding (new) - -#include - -newtype Method = Method (ForeignPtr Method) - -instance Object Method where - toObject (Method x) = SomeObject x - fromForeignPtr = Method - -instance Concrete Method where - concreteType _ = methodType - -{# fun pure hscpython_PyMethod_Type as methodType - {} -> `Type' peekStaticObject* #} - -{# fun PyMethod_New as new - `(Object func, Object self)' => - { withObject* `func' - , withObject* `self' - } -> `Method' stealObject* #} - -{# fun PyMethod_Function as function - { withObject* `Method' - } -> `SomeObject' peekObject* #} - -{# fun PyMethod_Self as self - { withObject* `Method' - } -> `SomeObject' peekObject* #} diff --git a/CPython/Types/Module.chs b/CPython/Types/Module.chs deleted file mode 100644 --- a/CPython/Types/Module.chs +++ /dev/null @@ -1,133 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Module - ( Module - , moduleType - , new - , getDictionary - , getName - , getFilename - , addObject - , addIntegerConstant - , addTextConstant - , importModule - , reload - ) where -import Prelude hiding (toInteger) -import Data.Text (Text) -import CPython.Internal hiding (new) -import CPython.Types.Integer (toInteger) -import CPython.Types.Unicode (toUnicode) - -#include - -newtype Module = Module (ForeignPtr Module) - -instance Object Module where - toObject (Module x) = SomeObject x - fromForeignPtr = Module - -instance Concrete Module where - concreteType _ = moduleType - -{# fun pure hscpython_PyModule_Type as moduleType - {} -> `Type' peekStaticObject* #} - --- | Return a new module object with the @__name__@ attribute set. Only the --- module’s @__doc__@ and @__name__@ attributes are filled in; the --- caller is responsible for providing a @__file__@ attribute. --- -{# fun PyModule_New as new - { withText* `Text' - } -> `Module' stealObject* #} - --- | Return the dictionary object that implements a module’s namespace; --- this object is the same as the @__dict__@ attribute of the module. This --- computation never fails. It is recommended extensions use other --- computations rather than directly manipulate a module’s @__dict__@. --- -{# fun PyModule_GetDict as getDictionary - { withObject* `Module' - } -> `Dictionary' peekObject* #} - --- | Returns a module’s @__name__@ value. If the module does not --- provide one, or if it is not a string, throws @SystemError@. --- -getName :: Module -> IO Text -getName py = - withObject py $ \py' -> do - raw <- {# call PyModule_GetName as ^ #} py' - exceptionIf $ raw == nullPtr - peekText raw - --- | Returns the name of the file from which a module was loaded using the --- module’s @__file__@ attribute. If this is not defined, or if it is --- not a string, throws @SystemError@. --- -getFilename :: Module -> IO Text -getFilename py = - withObject py $ \py' -> do - raw <- {# call PyModule_GetFilename as ^ #} py' - exceptionIf $ raw == nullPtr - peekText raw - --- | Add an object to a module with the given name. This is a convenience --- computation which can be used from the module’s initialization --- computation. --- -addObject :: Object value => Module -> Text -> value -> IO () -addObject py name val = - withObject py $ \py' -> - withText name $ \name' -> - withObject val $ \val' -> - incref val' >> - {# call PyModule_AddObject as ^ #} py' name' val' - >>= checkStatusCode - --- | Add an integer constant to a module. This convenience computation can be --- used from the module’s initialization computation. --- -addIntegerConstant :: Module -> Text -> Integer -> IO () -addIntegerConstant m name value = toInteger value >>= addObject m name - --- | Add a string constant to a module. This convenience computation can be --- used from the module’s initialization computation. --- -addTextConstant :: Module -> Text -> Text -> IO () -addTextConstant m name value = toUnicode value >>= addObject m name - --- | This is a higher-level interface that calls the current “import --- hook” (with an explicit level of @0@, meaning absolute import). It --- invokes the @__import__()@ computation from the @__builtins__@ of the --- current globals. This means that the import is done using whatever import --- hooks are installed in the current environment. --- --- This computation always uses absolute imports. --- -importModule :: Text -> IO Module -importModule name = do - pyName <- toUnicode name - withObject pyName $ \namePtr -> - {# call PyImport_Import as ^ #} namePtr - >>= stealObject - --- | Reload a module. If an error occurs, an exception is thrown and the old --- module still exists. --- -{# fun PyImport_ReloadModule as reload - { withObject* `Module' - } -> `Module' stealObject* #} diff --git a/CPython/Types/Set.chs b/CPython/Types/Set.chs deleted file mode 100644 --- a/CPython/Types/Set.chs +++ /dev/null @@ -1,156 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} - --- | Any functionality not listed below is best accessed using the either --- the 'Object' protocol (including 'callMethod', 'richCompare', 'hash', --- 'repr', 'isTrue', and 'getIter') or the 'Number' protocol (including 'and', --- 'subtract', 'or', 'xor', 'inPlaceAnd', 'inPlaceSubtract', 'inPlaceOr', --- and 'inPlaceXor'). --- -module CPython.Types.Set - ( AnySet - , Set - , FrozenSet - , setType - , frozenSetType - , toSet - , toFrozenSet - , iterableToSet - , iterableToFrozenSet - , fromSet - , size - , contains - , add - , discard - , pop - , clear - ) where -import CPython.Internal -import CPython.Types.Tuple (toTuple, iterableToTuple, fromTuple) - -#include - -class Object a => AnySet a - -newtype Set = Set (ForeignPtr Set) - -instance Object Set where - toObject (Set x) = SomeObject x - fromForeignPtr = Set - -instance Concrete Set where - concreteType _ = setType - -newtype FrozenSet = FrozenSet (ForeignPtr FrozenSet) - -instance Object FrozenSet where - toObject (FrozenSet x) = SomeObject x - fromForeignPtr = FrozenSet - -instance Concrete FrozenSet where - concreteType _ = frozenSetType - -instance AnySet Set -instance AnySet FrozenSet - -{# fun pure hscpython_PySet_Type as setType - {} -> `Type' peekStaticObject* #} - -{# fun pure hscpython_PyFrozenSet_Type as frozenSetType - {} -> `Type' peekStaticObject* #} - -toSet :: [SomeObject] -> IO Set -toSet xs = toTuple xs >>= iterableToSet - -toFrozenSet :: [SomeObject] -> IO FrozenSet -toFrozenSet xs = toTuple xs >>= iterableToFrozenSet - --- | Return a new 'Set' from the contents of an iterable 'Object'. The object --- may be 'Nothing' to create an empty set. Throws a @TypeError@ if the object --- is not iterable. --- -{# fun PySet_New as iterableToSet - `Object obj' => - { withObject* `obj' - } -> `Set' stealObject* #} - --- | Return a new 'FrozenSet' from the contents of an iterable 'Object'. The --- object may be 'Nothing' to create an empty frozen set. Throws a @TypeError@ --- if the object is not iterable. --- -{# fun PyFrozenSet_New as iterableToFrozenSet - `Object obj' => - { withObject* `obj' - } -> `FrozenSet' stealObject* #} - -fromSet :: AnySet set => set -> IO [SomeObject] -fromSet set = iterableToTuple set >>= fromTuple - --- | Return the size of a 'Set' or 'FrozenSet'. --- -{# fun PySet_Size as size - `AnySet set' => - { withObject* `set' - } -> `Integer' checkIntReturn* #} - --- | Return 'True' if found, 'False' if not found. Unlike the Python --- @__contains__()@ method, this computation does not automatically convert --- unhashable 'Set's into temporary 'FrozenSet's. Throws a @TypeError@ if the --- key is unhashable. --- -{# fun PySet_Contains as contains - `(AnySet set, Object key)' => - { withObject* `set' - , withObject* `key' - } -> `Bool' checkBoolReturn* #} - --- | Add /key/ to a 'Set'. Also works with 'FrozenSet' (like --- 'CPython.Types.Tuple.setItem' it can be used to fill-in the values of --- brand new 'FrozenSet's before they are exposed to other code). Throws a --- @TypeError@ if the key is unhashable. Throws a @MemoryError@ if there is --- no room to grow. --- -{# fun PySet_Add as add - `(AnySet set, Object key)' => - { withObject* `set' - , withObject* `key' - } -> `()' checkStatusCode* #} - --- | Return 'True' if found and removed, 'False' if not found (no action --- taken). Does not throw @KeyError@ for missing keys. Throws a @TypeError@ --- if /key/ is unhashable. Unlike the Python @discard()@ method, this --- computation does not automatically convert unhashable sets into temporary --- 'FrozenSet's. --- -{# fun PySet_Discard as discard - `Object key' => - { withObject* `Set' - , withObject* `key' - } -> `Bool' checkBoolReturn* #} - --- | Return an arbitrary object in the set, and removes the object from the --- set. Throws @KeyError@ if the set is empty. --- -{# fun PySet_Pop as pop - { withObject* `Set' - } -> `SomeObject' stealObject* #} - --- | Remove all elements from a set. --- -{# fun PySet_Clear as clear - { withObject* `Set' - } -> `()' checkStatusCode* #} diff --git a/CPython/Types/Slice.chs b/CPython/Types/Slice.chs deleted file mode 100644 --- a/CPython/Types/Slice.chs +++ /dev/null @@ -1,73 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Slice - ( Slice - , sliceType - , new - , getIndices - ) where -import Prelude hiding (length) -import CPython.Internal hiding (new) - -#include - -newtype Slice = Slice (ForeignPtr Slice) - -instance Object Slice where - toObject (Slice x) = SomeObject x - fromForeignPtr = Slice - -instance Concrete Slice where - concreteType _ = sliceType - -{# fun pure hscpython_PySlice_Type as sliceType - {} -> `Type' peekStaticObject* #} - --- | Return a new slice object with the given values. The /start/, /stop/, --- and /step/ parameters are used as the values of the slice object --- attributes of the same names. Any of the values may be 'Nothing', in which --- case @None@ will be used for the corresponding attribute. --- -new :: (Object start, Object stop, Object step) => Maybe start -> Maybe stop -> Maybe step -> IO Slice -new start stop step = - maybeWith withObject start $ \startPtr -> - maybeWith withObject stop $ \stopPtr -> - maybeWith withObject step $ \stepPtr -> - {# call PySlice_New as ^ #} startPtr stopPtr stepPtr - >>= stealObject - --- | Retrieve the start, stop, step, and slice length from a 'Slice', --- assuming a sequence of the given length. --- -getIndices :: Slice - -> Integer -- ^ Sequence length - -> IO (Integer, Integer, Integer, Integer) -getIndices slice length = - withObject slice $ \slicePtr -> - let length' = fromIntegral length in - alloca $ \startPtr -> - alloca $ \stopPtr -> - alloca $ \stepPtr -> - alloca $ \sliceLenPtr -> do - {# call PySlice_GetIndicesEx as ^ #} - slicePtr length' startPtr stopPtr stepPtr sliceLenPtr - >>= checkStatusCode - start <- fmap toInteger $ peek startPtr - stop <- fmap toInteger $ peek stopPtr - step <- fmap toInteger $ peek stepPtr - sliceLen <- fmap toInteger $ peek sliceLenPtr - return (start, stop, step, sliceLen) diff --git a/CPython/Types/Tuple.chs b/CPython/Types/Tuple.chs deleted file mode 100644 --- a/CPython/Types/Tuple.chs +++ /dev/null @@ -1,89 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Tuple - ( Tuple - , tupleType - , toTuple - , iterableToTuple - , fromTuple - , length - , getItem - , getSlice - , setItem - ) where -import Prelude hiding (length) -import CPython.Internal hiding (new) - -#include - -instance Concrete Tuple where - concreteType _ = tupleType - -{# fun pure hscpython_PyTuple_Type as tupleType - {} -> `Type' peekStaticObject* #} - -toTuple :: [SomeObject] -> IO Tuple -toTuple xs = - mapWith withObject xs $ \ptrs -> - withArrayLen ptrs $ \count array -> - {# call hscpython_poke_tuple #} (fromIntegral count) array - >>= stealObject - --- | Convert any object implementing the iterator protocol to a 'Tuple'. --- -iterableToTuple :: Object iter => iter -> IO Tuple -iterableToTuple iter = do - raw <- callObjectRaw tupleType =<< toTuple [toObject iter] - return $ unsafeCast raw - -fromTuple :: Tuple -> IO [SomeObject] -fromTuple py = - withObject py $ \pyPtr -> - ({# call PyTuple_Size as ^ #} pyPtr >>=) $ \size -> - let size' = fromIntegral size :: Int in - withArray (replicate size' nullPtr) $ \ptrs -> - {# call hscpython_peek_tuple #} pyPtr size ptrs >> - peekArray size' ptrs >>= mapM peekObject - -{# fun PyTuple_Size as length - { withObject* `Tuple' - } -> `Integer' checkIntReturn* #} - --- | Return the object at a given index from a tuple, or throws @IndexError@ --- if the index is out of bounds. --- -{# fun PyTuple_GetItem as getItem - { withObject* `Tuple' - , fromIntegral `Integer' - } -> `SomeObject' peekObject* #} - --- | Take a slice of a tuple from /low/ to /high/, and return it as a new --- tuple. --- -{# fun PyTuple_GetSlice as getSlice - { withObject* `Tuple' - , fromIntegral `Integer' - , fromIntegral `Integer' - } -> `Tuple' stealObject* #} - -setItem :: Object o => Tuple -> Integer -> o -> IO () -setItem self index x = - withObject self $ \selfPtr -> - withObject x $ \xPtr -> do - incref xPtr - {# call PyTuple_SetItem as ^ #} selfPtr (fromIntegral index) xPtr - >>= checkStatusCode diff --git a/CPython/Types/Type.chs b/CPython/Types/Type.chs deleted file mode 100644 --- a/CPython/Types/Type.chs +++ /dev/null @@ -1,38 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Type - ( Type - , typeType - , isSubtype - ) where -import CPython.Internal - -#include - -instance Concrete Type where - concreteType _ = typeType - -{# fun pure hscpython_PyType_Type as typeType - {} -> `Type' peekStaticObject* #} - --- | Returns 'True' if the first parameter is a subtype of the second --- parameter. --- -{# fun PyType_IsSubtype as isSubtype - { withObject* `Type' - , withObject* `Type' - } -> `Bool' #} diff --git a/CPython/Types/Unicode.chs b/CPython/Types/Unicode.chs deleted file mode 100644 --- a/CPython/Types/Unicode.chs +++ /dev/null @@ -1,326 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.Unicode - ( - -- * Unicode objects - Unicode - , Encoding - , ErrorHandling (..) - , unicodeType - , toUnicode - , fromUnicode - , length - , fromEncodedObject - , fromObject - , encode - , decode - - -- * Methods and slot functions - , append - , split - , splitLines - , translate - , join - , MatchDirection (..) - , tailMatch - , FindDirection (..) - , find - , count - , replace - , format - , contains - ) where -#include - -import Prelude hiding (length) -import Control.Exception (ErrorCall (..), throwIO) -import qualified Data.Text as T -#ifdef Py_UNICODE_WIDE -import Data.Char (chr, ord) -#else -import qualified Data.Text.Foreign as TF -#endif -import CPython.Internal -import CPython.Types.Bytes (Bytes) - -newtype Unicode = Unicode (ForeignPtr Unicode) - -instance Object Unicode where - toObject (Unicode x) = SomeObject x - fromForeignPtr = Unicode - -instance Concrete Unicode where - concreteType _ = unicodeType - -type Encoding = T.Text -data ErrorHandling - = Strict - | Replace - | Ignore - deriving (Show, Eq) - -withErrors :: ErrorHandling -> (CString -> IO a) -> IO a -withErrors errors = withCString $ case errors of - Strict -> "strict" - Replace -> "replace" - Ignore -> "ignore" - -{# fun pure hscpython_PyUnicode_Type as unicodeType - {} -> `Type' peekStaticObject* #} - -toUnicode :: T.Text -> IO Unicode -toUnicode str = withBuffer toPython >>= stealObject where - toPython ptr len = let - len' = fromIntegral len - ptr' = castPtr ptr - in {# call hscpython_PyUnicode_FromUnicode #} ptr' len' -#ifdef Py_UNICODE_WIDE - ords = map (fromIntegral . ord) (T.unpack str) :: [CUInt] - withBuffer = withArrayLen ords . flip -#else - withBuffer = TF.useAsPtr str -#endif - -fromUnicode :: Unicode -> IO T.Text -fromUnicode obj = withObject obj $ \ptr -> do - buffer <- {# call hscpython_PyUnicode_AsUnicode #} ptr - size <- {# call hscpython_PyUnicode_GetSize #} ptr -#ifdef Py_UNICODE_WIDE - raw <- peekArray (fromIntegral size) buffer - return . T.pack $ map (chr . fromIntegral) raw -#else - TF.fromPtr (castPtr buffer) (fromIntegral size) -#endif - -{# fun hscpython_PyUnicode_GetSize as length - { withObject* `Unicode' - } -> `Integer' checkIntReturn* #} - --- | Coerce an encoded object /obj/ to an Unicode object. --- --- 'Bytes' and other char buffer compatible objects are decoded according to --- the given encoding and error handling mode. --- --- All other objects, including 'Unicode' objects, cause a @TypeError@ to be --- thrown. --- -{# fun hscpython_PyUnicode_FromEncodedObject as fromEncodedObject - `Object obj' => - { withObject* `obj' - , withText* `Encoding' - , withErrors* `ErrorHandling' - } -> `Unicode' stealObject* #} - --- | Shortcut for @'fromEncodedObject' \"utf-8\" 'Strict'@ --- -fromObject :: Object obj => obj -> IO Unicode -fromObject obj = fromEncodedObject obj (T.pack "utf-8") Strict - --- | Encode a 'Unicode' object and return the result as 'Bytes' object. --- The encoding and error mode have the same meaning as the parameters of --- the the @str.encode()@ method. The codec to be used is looked up using --- the Python codec registry. --- -{# fun hscpython_PyUnicode_AsEncodedString as encode - { withObject* `Unicode' - , withText* `Encoding' - , withErrors* `ErrorHandling' - } -> `Bytes' stealObject* #} - --- | Create a 'Unicode' object by decoding a 'Bytes' object. The encoding and --- error mode have the same meaning as the parameters of the the --- @str.encode()@ method. The codec to be used is looked up using the Python --- codec registry. --- -decode :: Bytes -> Encoding -> ErrorHandling -> IO Unicode -decode bytes enc errors = - withObject bytes $ \bytesPtr -> - withText enc $ \encPtr -> - withErrors errors $ \errorsPtr -> - alloca $ \bufferPtr -> - alloca $ \lenPtr -> do - {# call PyBytes_AsStringAndSize as ^ #} bytesPtr bufferPtr lenPtr - >>= checkStatusCode - buffer <- peek bufferPtr - len <- peek lenPtr - {# call hscpython_PyUnicode_Decode #} buffer len encPtr errorsPtr - >>= stealObject - -{# fun hscpython_PyUnicode_Concat as append - { withObject* `Unicode' - , withObject* `Unicode' - } -> `Unicode' stealObject* #} - --- | Split a string giving a 'List' of 'Unicode' objects. If the separator is --- 'Nothing', splitting will be done at all whitespace substrings. Otherwise, --- splits occur at the given separator. Separators are not included in the --- resulting list. --- -split - :: Unicode - -> Maybe Unicode -- ^ Separator - -> Maybe Integer -- ^ Maximum splits - -> IO List -split s sep maxsplit = - withObject s $ \sPtr -> - maybeWith withObject sep $ \sepPtr -> - let max' = maybe (- 1) fromInteger maxsplit in - {# call hscpython_PyUnicode_Split #} sPtr sepPtr max' - >>= stealObject - --- | Split a 'Unicode' string at line breaks, returning a list of 'Unicode' --- strings. CRLF is considered to be one line break. If the second parameter --- is 'False', the line break characters are not included in the resulting --- strings. --- -{# fun hscpython_PyUnicode_Splitlines as splitLines - { withObject* `Unicode' - , `Bool' - } -> `List' stealObject* #} - --- | Translate a string by applying a character mapping table to it. --- --- The mapping table must map Unicode ordinal integers to Unicode ordinal --- integers or @None@ (causing deletion of the character). --- --- Mapping tables need only provide the @__getitem__()@ interface; --- dictionaries and sequences work well. Unmapped character ordinals (ones --- which cause a @LookupError@) are left untouched and are copied as-is. --- --- The error mode has the usual meaning for codecs. --- -{# fun hscpython_PyUnicode_Translate as translate - `Object table' => - { withObject* `Unicode' - , withObject* `table' - , withErrors* `ErrorHandling' - } -> `Unicode' stealObject* #} - --- | Join a sequence of strings using the given separator. --- -{# fun hscpython_PyUnicode_Join as join - `Sequence seq' => - { withObject* `Unicode' - , withObject* `seq' - } -> `Unicode' stealObject* #} - -data MatchDirection = Prefix | Suffix - deriving (Show, Eq) - --- | Return 'True' if the substring matches @string*[*start:end]@ at the --- given tail end (either a 'Prefix' or 'Suffix' match), 'False' otherwise. --- -tailMatch - :: Unicode -- ^ String - -> Unicode -- ^ Substring - -> Integer -- ^ Start - -> Integer -- ^ End - -> MatchDirection - -> IO Bool -tailMatch str substr start end dir = - withObject str $ \strPtr -> - withObject substr $ \substrPtr -> - let start' = fromInteger start in - let end' = fromInteger end in - let dir' = case dir of - Prefix -> -1 - Suffix -> 1 in - {# call hscpython_PyUnicode_Tailmatch #} strPtr substrPtr start' end' dir' - >>= checkBoolReturn - -data FindDirection = Forwards | Backwards - deriving (Show, Eq) - --- | Return the first position of the substring in @string*[*start:end]@ --- using the given direction. The return value is the index of the first --- match; a value of 'Nothing' indicates that no match was found. --- -find - :: Unicode -- ^ String - -> Unicode -- ^ Substring - -> Integer -- ^ Start - -> Integer -- ^ End - -> FindDirection - -> IO (Maybe Integer) -find str substr start end dir = - withObject str $ \strPtr -> - withObject substr $ \substrPtr -> do - let start' = fromInteger start - let end' = fromInteger end - let dir' = case dir of - Forwards -> 1 - Backwards -> -1 - cRes <- {# call hscpython_PyUnicode_Find #} strPtr substrPtr start' end' dir' - exceptionIf $ cRes == -2 - case cRes of - -1 -> return Nothing - x | x >= 0 -> return . Just . toInteger $ x - x -> throwIO . ErrorCall $ "Invalid return code: " ++ show x - --- | Return the number of non-overlapping occurrences of the substring in --- @string[start:end]@. --- -count - :: Unicode -- ^ String - -> Unicode -- ^ Substring - -> Integer -- ^ Start - -> Integer -- ^ End - -> IO Integer -count str substr start end = - withObject str $ \str' -> - withObject substr $ \substr' -> - let start' = fromInteger start in - let end' = fromInteger end in - {# call hscpython_PyUnicode_Count #} str' substr' start' end' - >>= checkIntReturn - --- | Replace occurrences of the substring with a given replacement. If the --- maximum count is 'Nothing', replace all occurences. --- -replace - :: Unicode -- ^ String - -> Unicode -- ^ Substring - -> Unicode -- ^ Replacement - -> Maybe Integer -- ^ Maximum count - -> IO Unicode -replace str substr replstr maxcount = - withObject str $ \strPtr -> - withObject substr $ \substrPtr -> - withObject replstr $ \replstrPtr -> - let maxcount' = case maxcount of - Nothing -> -1 - Just x -> fromInteger x in - {# call hscpython_PyUnicode_Replace #} strPtr substrPtr replstrPtr maxcount' - >>= stealObject - --- | Return a new 'Unicode' object from the given format and args; this is --- analogous to @format % args@. --- -{# fun hscpython_PyUnicode_Format as format - { withObject* `Unicode' - , withObject* `Tuple' - } -> `Unicode' stealObject* #} - --- | Check whether /element/ is contained in a string. --- --- /element/ has to coerce to a one element string. --- -{# fun hscpython_PyUnicode_Contains as contains - `Object element' => - { withObject* `Unicode' - , withObject* `element' - } -> `Bool' checkBoolReturn* #} diff --git a/CPython/Types/WeakReference.chs b/CPython/Types/WeakReference.chs deleted file mode 100644 --- a/CPython/Types/WeakReference.chs +++ /dev/null @@ -1,73 +0,0 @@ --- Copyright (C) 2009 John Millikin --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . --- -{-# LANGUAGE ForeignFunctionInterface #-} -module CPython.Types.WeakReference - ( Reference - , Proxy - , newReference - , newProxy - , getObject - ) where -import CPython.Internal - -#include - -newtype Reference = Reference (ForeignPtr Reference) -instance Object Reference where - toObject (Reference x) = SomeObject x - fromForeignPtr = Reference - -newtype Proxy = Proxy (ForeignPtr Proxy) -instance Object Proxy where - toObject (Proxy x) = SomeObject x - fromForeignPtr = Proxy - --- | Return a weak reference for the object. This will always return a new --- reference, but is not guaranteed to create a new object; an existing --- reference object may be returned. The second parameter, /callback/, can --- be a callable object that receives notification when /obj/ is garbage --- collected; it should accept a single parameter, which will be the weak --- reference object itself. If ob is not a weakly-referencable object, or if --- /callback/ is not callable, this will throw a @TypeError@. --- -newReference :: (Object obj, Object callback) => obj -> Maybe callback -> IO Reference -newReference obj cb = - withObject obj $ \objPtr -> - maybeWith withObject cb $ \cbPtr -> - {# call PyWeakref_NewRef as ^ #} objPtr cbPtr - >>= stealObject - --- | Return a weak reference proxy for the object. This will always return a --- new reference, but is not guaranteed to create a new object; an existing --- proxy may be returned. The second parameter, /callback/, can be a callable --- object that receives notification when /obj/ is garbage collected; it --- should accept a single parameter, which will be the weak reference object --- itself. If ob is not a weakly-referencable object, or if /callback/ is not --- callable, this will throw a @TypeError@. --- -newProxy :: (Object obj, Object callback) => obj -> Maybe callback -> IO Proxy -newProxy obj cb = - withObject obj $ \objPtr -> - maybeWith withObject cb $ \cbPtr -> - {# call PyWeakref_NewProxy as ^ #} objPtr cbPtr - >>= stealObject - --- | Return the referenced object from a weak reference. If the referent is --- no longer live, returns @None@. --- -{# fun PyWeakref_GetObject as getObject - { withObject* `Reference' - } -> `SomeObject' peekObject* #} diff --git a/cbits/hscpython-shim.c b/cbits/hscpython-shim.c new file mode 100644 --- /dev/null +++ b/cbits/hscpython-shim.c @@ -0,0 +1,247 @@ +/** + * Copyright (C) 2009 John Millikin + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . +**/ + +#include + +/* Initialization helpers */ +static wchar_t *program_name = NULL; +static wchar_t *python_home = NULL; + +static wchar_t *strdupw (wchar_t *s) +{ + size_t len = 0; + wchar_t *orig = s, *new, *new0; + if (!s) { return s; } + + while (*(s++)) { len++; } + new = new0 = malloc (sizeof (wchar_t) * len); + s = orig; + while (*(new++) = *(s++)) {} + return new0; +} + +void hscpython_SetProgramName (wchar_t *name) +{ + free (program_name); + program_name = strdupw (name); +} + +void hscpython_SetPythonHome (wchar_t *home) +{ + free (python_home); + python_home = strdupw (home); +} + +/* Object */ +void hscpython_Py_INCREF (PyObject *o) +{ Py_INCREF (o); } + +void hscpython_Py_DECREF (PyObject *o) +{ Py_DECREF (o); } + +int hscpython_PyObject_DelAttr(PyObject *o, PyObject *name) +{ return PyObject_DelAttr (o, name); } + +int hscpython_PyObject_TypeCheck (PyObject *o, PyTypeObject *type) +{ return PyObject_TypeCheck (o, type); } + +int hscpython_PyIter_Check(PyObject *o) +{ return PyIter_Check(o); } + +/* Types */ +PyTypeObject *hscpython_PyType_Type () +{ return &PyType_Type; } + +PyTypeObject *hscpython_PyTuple_Type () +{ return &PyTuple_Type; } + +PyTypeObject *hscpython_PyList_Type () +{ return &PyList_Type; } + +PyTypeObject *hscpython_PyDict_Type () +{ return &PyDict_Type; } + +PyTypeObject *hscpython_PyLong_Type () +{ return &PyLong_Type; } + +PyTypeObject *hscpython_PyFloat_Type () +{ return &PyFloat_Type; } + +PyTypeObject *hscpython_PyComplex_Type () +{ return &PyComplex_Type; } + +PyTypeObject *hscpython_PyUnicode_Type () +{ return &PyUnicode_Type; } + +PyTypeObject *hscpython_PyBytes_Type () +{ return &PyBytes_Type; } + +PyTypeObject *hscpython_PyByteArray_Type () +{ return &PyByteArray_Type; } + +PyTypeObject *hscpython_PyCell_Type () +{ return &PyCell_Type; } + +PyTypeObject *hscpython_PyCode_Type () +{ return &PyCode_Type; } + +PyTypeObject *hscpython_PyFunction_Type () +{ return &PyFunction_Type; } + +PyTypeObject *hscpython_PyInstanceMethod_Type () +{ return &PyInstanceMethod_Type; } + +PyTypeObject *hscpython_PyMethod_Type () +{ return &PyMethod_Type; } + +PyTypeObject *hscpython_PySet_Type () +{ return &PySet_Type; } + +PyTypeObject *hscpython_PyFrozenSet_Type () +{ return &PyFrozenSet_Type; } + +PyTypeObject *hscpython_PySeqIter_Type () +{ return &PySeqIter_Type; } + +PyTypeObject *hscpython_PyCallIter_Type () +{ return &PyCallIter_Type; } + +PyTypeObject *hscpython_PySlice_Type () +{ return &PySlice_Type; } + +PyTypeObject *hscpython_PyModule_Type () +{ return &PyModule_Type; } + +PyTypeObject *hscpython_PyCapsule_Type () +{ return &PyCapsule_Type; } + +/* Constants */ +PyObject *hscpython_Py_None () +{ return Py_None; } + +PyObject *hscpython_Py_True () +{ return Py_True; } + +PyObject *hscpython_Py_False () +{ return Py_False; } + +/* Unicode */ +Py_ssize_t hscpython_PyUnicode_GetSize (PyObject *o) +{ return PyUnicode_GetSize (o); } + +Py_UNICODE *hscpython_PyUnicode_AsUnicode (PyObject *o) +{ return PyUnicode_AsUnicode (o); } + +PyObject *hscpython_PyUnicode_FromUnicode (Py_UNICODE *u, Py_ssize_t size) +{ return PyUnicode_FromUnicode (u, size); } + +PyObject *hscpython_PyUnicode_FromEncodedObject (PyObject *o, const char *enc, const char *err) +{ return PyUnicode_FromEncodedObject (o, enc, err); } + +PyObject *hscpython_PyUnicode_AsEncodedString (PyObject *o, const char *enc, const char *err) +{ return PyUnicode_AsEncodedString (o, enc, err); } + +PyObject *hscpython_PyUnicode_FromObject (PyObject *o) +{ return PyUnicode_FromObject (o); } + +PyObject *hscpython_PyUnicode_Decode (const char *s, Py_ssize_t len, const char *enc, const char *err) +{ return PyUnicode_Decode (s, len, enc, err); } + +PyObject *hscpython_PyUnicode_Concat (PyObject *l, PyObject *r) +{ return PyUnicode_Concat (l, r); } + +PyObject *hscpython_PyUnicode_Split (PyObject *s, PyObject *sep, Py_ssize_t max) +{ return PyUnicode_Split (s, sep, max); } + +PyObject *hscpython_PyUnicode_Splitlines (PyObject *s, int keep) +{ return PyUnicode_Splitlines (s, keep); } + +PyObject *hscpython_PyUnicode_Translate (PyObject *str, PyObject *table, const char *err) +{ return PyUnicode_Translate (str, table, err); } + +PyObject *hscpython_PyUnicode_Join (PyObject *sep, PyObject *seq) +{ return PyUnicode_Join (sep, seq); } + +int hscpython_PyUnicode_Tailmatch (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end, int dir) +{ return PyUnicode_Tailmatch (str, substr, start, end, dir); } + +Py_ssize_t hscpython_PyUnicode_Find (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end, int dir) +{ return PyUnicode_Find (str, substr, start, end, dir); } + +Py_ssize_t hscpython_PyUnicode_Count (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end) +{ return PyUnicode_Count (str, substr, start, end); } + +PyObject *hscpython_PyUnicode_Replace (PyObject *str, PyObject *substr, PyObject *replstr, Py_ssize_t max) +{ return PyUnicode_Replace (str, substr, replstr, max); } + +PyObject *hscpython_PyUnicode_Format (PyObject *format, PyObject *args) +{ return PyUnicode_Format (format, args); } + +int hscpython_PyUnicode_Contains (PyObject *a, PyObject *b) +{ return PyUnicode_Contains (a, b); } + +/* Lists */ +void hscpython_peek_list (PyObject *list, Py_ssize_t size, PyObject **objs) +{ + Py_ssize_t ii; + for (ii = 0; ii < size; ii++) + { + objs[ii] = PyList_GET_ITEM (list, ii); + } +} + +PyObject *hscpython_poke_list (size_t count, PyObject **objs) +{ + PyObject *list; + size_t ii; + + if (!(list = PyList_New (count))) + { return NULL; } + + for (ii = 0; ii < count; ii++) + { + Py_INCREF (objs[ii]); + PyList_SET_ITEM (list, ii, objs[ii]); + } + return list; +} + +/* Tuple */ +void hscpython_peek_tuple (PyObject *tuple, Py_ssize_t size, PyObject **objs) +{ + Py_ssize_t ii; + for (ii = 0; ii < size; ii++) + { + objs[ii] = PyTuple_GET_ITEM (tuple, ii); + } +} + +PyObject *hscpython_poke_tuple (size_t count, PyObject **objs) +{ + PyObject *tuple; + size_t ii; + + if (!(tuple = PyTuple_New (count))) + { return NULL; } + + for (ii = 0; ii < count; ii++) + { + Py_INCREF (objs[ii]); + PyTuple_SET_ITEM (tuple, ii, objs[ii]); + } + return tuple; +} diff --git a/cbits/hscpython-shim.h b/cbits/hscpython-shim.h new file mode 100644 --- /dev/null +++ b/cbits/hscpython-shim.h @@ -0,0 +1,83 @@ +#ifndef HSCPYTHON_SHIM_H +#define HSCPYTHON_SHIM_H + +#include + +/* Initialization helpers */ +void hscpython_SetProgramName (wchar_t *); +void hscpython_SetPythonHome (wchar_t *); + +/* Object */ +void hscpython_Py_INCREF (PyObject *); +void hscpython_Py_DECREF (PyObject *); +int hscpython_PyObject_DelAttr(PyObject *, PyObject *); +int hscpython_PyObject_TypeCheck (PyObject *, PyTypeObject *); +int hscpython_PyIter_Check(PyObject *); + +enum HSCPythonComparisonEnum +{ HSCPYTHON_LT = Py_LT +, HSCPYTHON_LE = Py_LE +, HSCPYTHON_EQ = Py_EQ +, HSCPYTHON_NE = Py_NE +, HSCPYTHON_GT = Py_GT +, HSCPYTHON_GE = Py_GE +}; + +/* Types */ +PyTypeObject *hscpython_PyType_Type (); +PyTypeObject *hscpython_PyTuple_Type (); +PyTypeObject *hscpython_PyList_Type (); +PyTypeObject *hscpython_PyDict_Type (); +PyTypeObject *hscpython_PyLong_Type (); +PyTypeObject *hscpython_PyFloat_Type (); +PyTypeObject *hscpython_PyComplex_Type (); +PyTypeObject *hscpython_PyUnicode_Type (); +PyTypeObject *hscpython_PyBytes_Type (); +PyTypeObject *hscpython_PyByteArray_Type (); +PyTypeObject *hscpython_PyCell_Type (); +PyTypeObject *hscpython_PyCode_Type (); +PyTypeObject *hscpython_PyFunction_Type (); +PyTypeObject *hscpython_PyInstanceMethod_Type (); +PyTypeObject *hscpython_PyMethod_Type (); +PyTypeObject *hscpython_PySet_Type (); +PyTypeObject *hscpython_PyFrozenSet_Type (); +PyTypeObject *hscpython_PySeqIter_Type (); +PyTypeObject *hscpython_PyCallIter_Type (); +PyTypeObject *hscpython_PySlice_Type (); +PyTypeObject *hscpython_PyModule_Type (); +PyTypeObject *hscpython_PyCapsule_Type (); + +/* Constants */ +PyObject *hscpython_Py_None (); +PyObject *hscpython_Py_True (); +PyObject *hscpython_Py_False (); + +/* Unicode */ +Py_ssize_t hscpython_PyUnicode_GetSize (PyObject *); +Py_UNICODE *hscpython_PyUnicode_AsUnicode (PyObject *); +PyObject *hscpython_PyUnicode_FromUnicode (Py_UNICODE *, Py_ssize_t); +PyObject *hscpython_PyUnicode_FromEncodedObject (PyObject *, const char *, const char *); +PyObject *hscpython_PyUnicode_AsEncodedString (PyObject *, const char *, const char *); +PyObject *hscpython_PyUnicode_FromObject (PyObject *); +PyObject *hscpython_PyUnicode_Decode (const char *, Py_ssize_t, const char *, const char *); +PyObject *hscpython_PyUnicode_Concat (PyObject *, PyObject *); +PyObject *hscpython_PyUnicode_Split (PyObject *, PyObject *, Py_ssize_t); +PyObject *hscpython_PyUnicode_Splitlines (PyObject *, int); +PyObject *hscpython_PyUnicode_Translate (PyObject *, PyObject *, const char *); +PyObject *hscpython_PyUnicode_Join (PyObject *, PyObject *); +int hscpython_PyUnicode_Tailmatch (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t, int); +Py_ssize_t hscpython_PyUnicode_Find (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t, int); +Py_ssize_t hscpython_PyUnicode_Count (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t); +PyObject *hscpython_PyUnicode_Replace (PyObject *, PyObject *, PyObject *, Py_ssize_t); +PyObject *hscpython_PyUnicode_Format (PyObject *, PyObject *); +int hscpython_PyUnicode_Contains (PyObject *, PyObject *); + +/* Lists */ +void hscpython_peek_list (PyObject *, Py_ssize_t, PyObject **); +PyObject *hscpython_poke_list (size_t, PyObject **); + +/* Tuples */ +void hscpython_peek_tuple (PyObject *, Py_ssize_t, PyObject **); +PyObject *hscpython_poke_tuple (size_t, PyObject **); + +#endif diff --git a/cpython.cabal b/cpython.cabal --- a/cpython.cabal +++ b/cpython.cabal @@ -1,19 +1,15 @@ name: cpython -version: 3.1.2.1 -synopsis: Bindings for libpython +version: 3.1.3 license: GPL-3 license-file: license.txt -author: John Millikin -maintainer: jmillikin@gmail.com -copyright: Copyright (c) John Millikin 2009-2010, - (c) Python Software Foundation 2001-2009. +author: John Millikin +maintainer: John Millikin build-type: Simple -cabal-version: >=1.6 +cabal-version: >= 1.6 category: Foreign -homepage: http://john-millikin.com/software/bindings/cpython/ -tested-with: GHC==6.12.1 -extra-source-files: hscpython-shim.h +homepage: https://john-millikin.com/software/haskell-python/ +synopsis: Bindings for libpython description: These bindings allow Haskell code to call CPython code. It is not currently possible to call Haskell code from CPython, but this feature @@ -21,19 +17,28 @@ . Please note that this library uses a somewhat abnormal versioning scheme; the first two version numbers are the CPython version, the third is the - package's major version, and the fourth is the package's minor version. - For example, the package version 3.1.1.0 binds to CPython 3.1, and has - a package version of (1, 0). + package's version. For example, the package version 3.1.1 binds to CPython + 3.1, and has a package version of 1. +extra-source-files: + cbits/hscpython-shim.h + source-repository head type: bazaar - location: http://john-millikin.com/software/bindings/cpython/ + location: https://john-millikin.com/branches/haskell-cpython/3.1/ +source-repository this + type: bazaar + location: https://john-millikin.com/branches/haskell-cpython/3.1/ + tag: haskell-cpython_3.1.3 + library - ghc-options: -Wall -fno-warn-orphans + ghc-options: -Wall -O2 + hs-source-dirs: lib + build-depends: - base >=4 && < 5 - , bytestring >= 0.9 && < 0.10 + base >= 4.0 && < 5.0 + , bytestring >= 0.9 , text >= 0.1 && < 0.12 build-tools: @@ -76,7 +81,7 @@ other-modules: CPython.Internal - c-sources: hscpython-shim.c - include-dirs: . + c-sources: cbits/hscpython-shim.c + include-dirs: cbits pkgconfig-depends: python-3.1 diff --git a/hscpython-shim.c b/hscpython-shim.c deleted file mode 100644 --- a/hscpython-shim.c +++ /dev/null @@ -1,247 +0,0 @@ -/** - * Copyright (C) 2009 John Millikin - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program. If not, see . -**/ - -#include - -/* Initialization helpers */ -static wchar_t *program_name = NULL; -static wchar_t *python_home = NULL; - -static wchar_t *strdupw (wchar_t *s) -{ - size_t len = 0; - wchar_t *orig = s, *new, *new0; - if (!s) { return s; } - - while (*(s++)) { len++; } - new = new0 = malloc (sizeof (wchar_t) * len); - s = orig; - while (*(new++) = *(s++)) {} - return new0; -} - -void hscpython_SetProgramName (wchar_t *name) -{ - free (program_name); - program_name = strdupw (name); -} - -void hscpython_SetPythonHome (wchar_t *home) -{ - free (python_home); - python_home = strdupw (home); -} - -/* Object */ -void hscpython_Py_INCREF (PyObject *o) -{ Py_INCREF (o); } - -void hscpython_Py_DECREF (PyObject *o) -{ Py_DECREF (o); } - -int hscpython_PyObject_DelAttr(PyObject *o, PyObject *name) -{ return PyObject_DelAttr (o, name); } - -int hscpython_PyObject_TypeCheck (PyObject *o, PyTypeObject *type) -{ return PyObject_TypeCheck (o, type); } - -int hscpython_PyIter_Check(PyObject *o) -{ return PyIter_Check(o); } - -/* Types */ -PyTypeObject *hscpython_PyType_Type () -{ return &PyType_Type; } - -PyTypeObject *hscpython_PyTuple_Type () -{ return &PyTuple_Type; } - -PyTypeObject *hscpython_PyList_Type () -{ return &PyList_Type; } - -PyTypeObject *hscpython_PyDict_Type () -{ return &PyDict_Type; } - -PyTypeObject *hscpython_PyLong_Type () -{ return &PyLong_Type; } - -PyTypeObject *hscpython_PyFloat_Type () -{ return &PyFloat_Type; } - -PyTypeObject *hscpython_PyComplex_Type () -{ return &PyComplex_Type; } - -PyTypeObject *hscpython_PyUnicode_Type () -{ return &PyUnicode_Type; } - -PyTypeObject *hscpython_PyBytes_Type () -{ return &PyBytes_Type; } - -PyTypeObject *hscpython_PyByteArray_Type () -{ return &PyByteArray_Type; } - -PyTypeObject *hscpython_PyCell_Type () -{ return &PyCell_Type; } - -PyTypeObject *hscpython_PyCode_Type () -{ return &PyCode_Type; } - -PyTypeObject *hscpython_PyFunction_Type () -{ return &PyFunction_Type; } - -PyTypeObject *hscpython_PyInstanceMethod_Type () -{ return &PyInstanceMethod_Type; } - -PyTypeObject *hscpython_PyMethod_Type () -{ return &PyMethod_Type; } - -PyTypeObject *hscpython_PySet_Type () -{ return &PySet_Type; } - -PyTypeObject *hscpython_PyFrozenSet_Type () -{ return &PyFrozenSet_Type; } - -PyTypeObject *hscpython_PySeqIter_Type () -{ return &PySeqIter_Type; } - -PyTypeObject *hscpython_PyCallIter_Type () -{ return &PyCallIter_Type; } - -PyTypeObject *hscpython_PySlice_Type () -{ return &PySlice_Type; } - -PyTypeObject *hscpython_PyModule_Type () -{ return &PyModule_Type; } - -PyTypeObject *hscpython_PyCapsule_Type () -{ return &PyCapsule_Type; } - -/* Constants */ -PyObject *hscpython_Py_None () -{ return Py_None; } - -PyObject *hscpython_Py_True () -{ return Py_True; } - -PyObject *hscpython_Py_False () -{ return Py_False; } - -/* Unicode */ -Py_ssize_t hscpython_PyUnicode_GetSize (PyObject *o) -{ return PyUnicode_GetSize (o); } - -Py_UNICODE *hscpython_PyUnicode_AsUnicode (PyObject *o) -{ return PyUnicode_AsUnicode (o); } - -PyObject *hscpython_PyUnicode_FromUnicode (Py_UNICODE *u, Py_ssize_t size) -{ return PyUnicode_FromUnicode (u, size); } - -PyObject *hscpython_PyUnicode_FromEncodedObject (PyObject *o, const char *enc, const char *err) -{ return PyUnicode_FromEncodedObject (o, enc, err); } - -PyObject *hscpython_PyUnicode_AsEncodedString (PyObject *o, const char *enc, const char *err) -{ return PyUnicode_AsEncodedString (o, enc, err); } - -PyObject *hscpython_PyUnicode_FromObject (PyObject *o) -{ return PyUnicode_FromObject (o); } - -PyObject *hscpython_PyUnicode_Decode (const char *s, Py_ssize_t len, const char *enc, const char *err) -{ return PyUnicode_Decode (s, len, enc, err); } - -PyObject *hscpython_PyUnicode_Concat (PyObject *l, PyObject *r) -{ return PyUnicode_Concat (l, r); } - -PyObject *hscpython_PyUnicode_Split (PyObject *s, PyObject *sep, Py_ssize_t max) -{ return PyUnicode_Split (s, sep, max); } - -PyObject *hscpython_PyUnicode_Splitlines (PyObject *s, int keep) -{ return PyUnicode_Splitlines (s, keep); } - -PyObject *hscpython_PyUnicode_Translate (PyObject *str, PyObject *table, const char *err) -{ return PyUnicode_Translate (str, table, err); } - -PyObject *hscpython_PyUnicode_Join (PyObject *sep, PyObject *seq) -{ return PyUnicode_Join (sep, seq); } - -int hscpython_PyUnicode_Tailmatch (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end, int dir) -{ return PyUnicode_Tailmatch (str, substr, start, end, dir); } - -Py_ssize_t hscpython_PyUnicode_Find (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end, int dir) -{ return PyUnicode_Find (str, substr, start, end, dir); } - -Py_ssize_t hscpython_PyUnicode_Count (PyObject *str, PyObject *substr, Py_ssize_t start, Py_ssize_t end) -{ return PyUnicode_Count (str, substr, start, end); } - -PyObject *hscpython_PyUnicode_Replace (PyObject *str, PyObject *substr, PyObject *replstr, Py_ssize_t max) -{ return PyUnicode_Replace (str, substr, replstr, max); } - -PyObject *hscpython_PyUnicode_Format (PyObject *format, PyObject *args) -{ return PyUnicode_Format (format, args); } - -int hscpython_PyUnicode_Contains (PyObject *a, PyObject *b) -{ return PyUnicode_Contains (a, b); } - -/* Lists */ -void hscpython_peek_list (PyObject *list, Py_ssize_t size, PyObject **objs) -{ - Py_ssize_t ii; - for (ii = 0; ii < size; ii++) - { - objs[ii] = PyList_GET_ITEM (list, ii); - } -} - -PyObject *hscpython_poke_list (size_t count, PyObject **objs) -{ - PyObject *list; - size_t ii; - - if (!(list = PyList_New (count))) - { return NULL; } - - for (ii = 0; ii < count; ii++) - { - Py_INCREF (objs[ii]); - PyList_SET_ITEM (list, ii, objs[ii]); - } - return list; -} - -/* Tuple */ -void hscpython_peek_tuple (PyObject *tuple, Py_ssize_t size, PyObject **objs) -{ - Py_ssize_t ii; - for (ii = 0; ii < size; ii++) - { - objs[ii] = PyTuple_GET_ITEM (tuple, ii); - } -} - -PyObject *hscpython_poke_tuple (size_t count, PyObject **objs) -{ - PyObject *tuple; - size_t ii; - - if (!(tuple = PyTuple_New (count))) - { return NULL; } - - for (ii = 0; ii < count; ii++) - { - Py_INCREF (objs[ii]); - PyTuple_SET_ITEM (tuple, ii, objs[ii]); - } - return tuple; -} diff --git a/hscpython-shim.h b/hscpython-shim.h deleted file mode 100644 --- a/hscpython-shim.h +++ /dev/null @@ -1,83 +0,0 @@ -#ifndef HSCPYTHON_SHIM_H -#define HSCPYTHON_SHIM_H - -#include - -/* Initialization helpers */ -void hscpython_SetProgramName (wchar_t *); -void hscpython_SetPythonHome (wchar_t *); - -/* Object */ -void hscpython_Py_INCREF (PyObject *); -void hscpython_Py_DECREF (PyObject *); -int hscpython_PyObject_DelAttr(PyObject *, PyObject *); -int hscpython_PyObject_TypeCheck (PyObject *, PyTypeObject *); -int hscpython_PyIter_Check(PyObject *); - -enum HSCPythonComparisonEnum -{ HSCPYTHON_LT = Py_LT -, HSCPYTHON_LE = Py_LE -, HSCPYTHON_EQ = Py_EQ -, HSCPYTHON_NE = Py_NE -, HSCPYTHON_GT = Py_GT -, HSCPYTHON_GE = Py_GE -}; - -/* Types */ -PyTypeObject *hscpython_PyType_Type (); -PyTypeObject *hscpython_PyTuple_Type (); -PyTypeObject *hscpython_PyList_Type (); -PyTypeObject *hscpython_PyDict_Type (); -PyTypeObject *hscpython_PyLong_Type (); -PyTypeObject *hscpython_PyFloat_Type (); -PyTypeObject *hscpython_PyComplex_Type (); -PyTypeObject *hscpython_PyUnicode_Type (); -PyTypeObject *hscpython_PyBytes_Type (); -PyTypeObject *hscpython_PyByteArray_Type (); -PyTypeObject *hscpython_PyCell_Type (); -PyTypeObject *hscpython_PyCode_Type (); -PyTypeObject *hscpython_PyFunction_Type (); -PyTypeObject *hscpython_PyInstanceMethod_Type (); -PyTypeObject *hscpython_PyMethod_Type (); -PyTypeObject *hscpython_PySet_Type (); -PyTypeObject *hscpython_PyFrozenSet_Type (); -PyTypeObject *hscpython_PySeqIter_Type (); -PyTypeObject *hscpython_PyCallIter_Type (); -PyTypeObject *hscpython_PySlice_Type (); -PyTypeObject *hscpython_PyModule_Type (); -PyTypeObject *hscpython_PyCapsule_Type (); - -/* Constants */ -PyObject *hscpython_Py_None (); -PyObject *hscpython_Py_True (); -PyObject *hscpython_Py_False (); - -/* Unicode */ -Py_ssize_t hscpython_PyUnicode_GetSize (PyObject *); -Py_UNICODE *hscpython_PyUnicode_AsUnicode (PyObject *); -PyObject *hscpython_PyUnicode_FromUnicode (Py_UNICODE *, Py_ssize_t); -PyObject *hscpython_PyUnicode_FromEncodedObject (PyObject *, const char *, const char *); -PyObject *hscpython_PyUnicode_AsEncodedString (PyObject *, const char *, const char *); -PyObject *hscpython_PyUnicode_FromObject (PyObject *); -PyObject *hscpython_PyUnicode_Decode (const char *, Py_ssize_t, const char *, const char *); -PyObject *hscpython_PyUnicode_Concat (PyObject *, PyObject *); -PyObject *hscpython_PyUnicode_Split (PyObject *, PyObject *, Py_ssize_t); -PyObject *hscpython_PyUnicode_Splitlines (PyObject *, int); -PyObject *hscpython_PyUnicode_Translate (PyObject *, PyObject *, const char *); -PyObject *hscpython_PyUnicode_Join (PyObject *, PyObject *); -int hscpython_PyUnicode_Tailmatch (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t, int); -Py_ssize_t hscpython_PyUnicode_Find (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t, int); -Py_ssize_t hscpython_PyUnicode_Count (PyObject *, PyObject *, Py_ssize_t, Py_ssize_t); -PyObject *hscpython_PyUnicode_Replace (PyObject *, PyObject *, PyObject *, Py_ssize_t); -PyObject *hscpython_PyUnicode_Format (PyObject *, PyObject *); -int hscpython_PyUnicode_Contains (PyObject *, PyObject *); - -/* Lists */ -void hscpython_peek_list (PyObject *, Py_ssize_t, PyObject **); -PyObject *hscpython_poke_list (size_t, PyObject **); - -/* Tuples */ -void hscpython_peek_tuple (PyObject *, Py_ssize_t, PyObject **); -PyObject *hscpython_poke_tuple (size_t, PyObject **); - -#endif diff --git a/lib/CPython.chs b/lib/CPython.chs new file mode 100644 --- /dev/null +++ b/lib/CPython.chs @@ -0,0 +1,370 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython + ( initialize + , isInitialized + , finalize + , newInterpreter + , endInterpreter + , getProgramName + , setProgramName + , getPrefix + , getExecPrefix + , getProgramFullPath + , getPath + , getVersion + , getPlatform + , getCopyright + , getCompiler + , getBuildInfo + , setArgv + , getPythonHome + , setPythonHome + ) where +import Data.Text (Text) +import CPython.Internal + +#include + +-- | Initialize the Python interpreter. In an application embedding Python, +-- this should be called before using any other Python/C API computations; +-- with the exception of 'setProgramName', 'initThreads', +-- 'releaseLock', and 'acquireLock'. This initializes the table +-- of loaded modules (@sys.modules@), and creates the fundamental modules +-- @builtins@, @__main__@ and @sys@. It also initializes the module search +-- path (@sys.path@). It does not set @sys.argv@; use 'setArgv' for that. This +-- is a no-op when called for a second time (without calling 'finalize' +-- first). There is no return value; it is a fatal error if the initialization +-- fails. +-- +{# fun Py_Initialize as initialize + {} -> `()' id #} + +-- | Return 'True' when the Python interpreter has been initialized, 'False' +-- if not. After 'finalize' is called, this returns 'False' until +-- 'initialize' is called again. +-- +{# fun Py_IsInitialized as isInitialized + {} -> `Bool' #} + +-- | Undo all initializations made by 'initialize' and subsequent use of +-- Python/C API computations, and destroy all sub-interpreters (see +-- 'newInterpreter' below) that were created and not yet destroyed since the +-- last call to 'initialize'. Ideally, this frees all memory allocated by the +-- Python interpreter. This is a no-op when called for a second time (without +-- calling 'initialize' again first). There is no return value; errors during +-- finalization are ignored. + +-- This computation is provided for a number of reasons. An embedding +-- application might want to restart Python without having to restart the +-- application itself. An application that has loaded the Python interpreter +-- from a dynamically loadable library (or DLL) might want to free all memory +-- allocated by Python before unloading the DLL. During a hunt for memory +-- leaks in an application a developer might want to free all memory +-- allocated by Python before exiting from the application. + +-- /Bugs and caveats/: The destruction of modules and objects in modules is +-- done in arbitrary order; this may cause destructors (@__del__()@ methods) +-- to fail when they depend on other objects (even functions) or modules. +-- Dynamically loaded extension modules loaded by Python are not unloaded. +-- Small amounts of memory allocated by the Python interpreter may not be +-- freed (if you find a leak, please report it). Memory tied up in circular +-- references between objects is not freed. Some memory allocated by extension +-- modules may not be freed. Some extensions may not work properly if their +-- initialization routine is called more than once; this can happen if an +-- application calls 'initialize' and 'finalize' more than once. +-- +{# fun Py_Finalize as finalize + {} -> `()' id #} + +newtype ThreadState = ThreadState (Ptr ThreadState) + +-- | Create a new sub-interpreter. This is an (almost) totally separate +-- environment for the execution of Python code. In particular, the new +-- interpreter has separate, independent versions of all imported modules, +-- including the fundamental modules @builtins@, @__main__@ and @sys@. The +-- table of loaded modules (@sys.modules@) and the module search path +-- (@sys.path@) are also separate. The new environment has no @sys.argv@ +-- variable. It has new standard I/O stream file objects @sys.stdin@, +-- @sys.stdout@ and @sys.stderr@ (however these refer to the same underlying +-- @FILE@ structures in the C library). +-- +-- The return value points to the first thread state created in the new +-- sub-interpreter. This thread state is made in the current thread state. +-- Note that no actual thread is created; see the discussion of thread states +-- below. If creation of the new interpreter is unsuccessful, 'Nothing' is +-- returned; no exception is set since the exception state is stored in the +-- current thread state and there may not be a current thread state. (Like +-- all other Python/C API computations, the global interpreter lock must be +-- held before calling this computation and is still held when it returns; +-- however, unlike most other Python/C API computations, there +-- needn’t be a current thread state on entry.) +-- +-- Extension modules are shared between (sub-)interpreters as follows: the +-- first time a particular extension is imported, it is initialized normally, +-- and a (shallow) copy of its module’s dictionary is squirreled away. +-- When the same extension is imported by another (sub-)interpreter, a new +-- module is initialized and filled with the contents of this copy; the +-- extension’s @init@ procedure is not called. Note that this is +-- different from what happens when an extension is imported after the +-- interpreter has been completely re-initialized by calling 'finalize' and +-- 'initialize'; in that case, the extension’s @init/module/@ +-- procedure is called again. +-- +-- /Bugs and caveats/: Because sub-interpreters (and the main interpreter) +-- are part of the same process, the insulation between them isn’t +-- perfect — for example, using low-level file operations like +-- @os.close()@ they can (accidentally or maliciously) affect each +-- other’s open files. Because of the way extensions are shared +-- between (sub-)interpreters, some extensions may not work properly; this +-- is especially likely when the extension makes use of (static) global +-- variables, or when the extension manipulates its module’s +-- dictionary after its initialization. It is possible to insert objects +-- created in one sub-interpreter into a namespace of another +-- sub-interpreter; this should be done with great care to avoid sharing +-- user-defined functions, methods, instances or classes between +-- sub-interpreters, since import operations executed by such objects may +-- affect the wrong (sub-)interpreter’s dictionary of loaded modules. +-- (XXX This is a hard-to-fix bug that will be addressed in a future release.) +-- +-- Also note that the use of this functionality is incompatible with +-- extension modules such as PyObjC and ctypes that use the @PyGILState_*()@ +-- APIs (and this is inherent in the way the @PyGILState_*()@ procedures +-- work). Simple things may work, but confusing behavior will always be near. +-- +newInterpreter :: IO (Maybe ThreadState) +newInterpreter = do + ptr <- {# call Py_NewInterpreter as ^ #} + return $ if ptr == nullPtr + then Nothing + else Just $ ThreadState $ castPtr ptr + +-- | Destroy the (sub-)interpreter represented by the given thread state. +-- The given thread state must be the current thread state. See the +-- discussion of thread states below. When the call returns, the current +-- thread state is @NULL@. All thread states associated with this +-- interpreter are destroyed. (The global interpreter lock must be held +-- before calling this computation and is still held when it returns.) +-- 'finalize' will destroy all sub-interpreters that haven’t been +-- explicitly destroyed at that point. +-- +endInterpreter :: ThreadState -> IO () +endInterpreter (ThreadState ptr) = + {# call Py_EndInterpreter as ^ #} $ castPtr ptr + +-- | Return the program name set with 'setProgramName', or the default. +-- +getProgramName :: IO Text +getProgramName = pyGetProgramName >>= peekTextW + +foreign import ccall safe "hscpython-shim.h Py_GetProgramName" + pyGetProgramName :: IO CWString + +-- | This computation should be called before 'initialize' is called for the +-- first time, if it is called at all. It tells the interpreter the value of +-- the @argv[0]@ argument to the @main@ procedure of the program. This is +-- used by 'getPath' and some other computations below to find the Python +-- run-time libraries relative to the interpreter executable. The default +-- value is @\"python\"@. No code in the Python interpreter will change the +-- program name. +-- +setProgramName :: Text -> IO () +setProgramName name = withTextW name cSetProgramName + +foreign import ccall safe "hscpython-shim.h hscpython_SetProgramName" + cSetProgramName :: CWString -> IO () + +-- | Return the prefix for installed platform-independent files. This is +-- derived through a number of complicated rules from the program name set +-- with 'setProgramName' and some environment variables; for example, if the +-- program name is @\"\/usr\/local\/bin\/python\"@, the prefix is +-- @\"\/usr\/local\"@. This corresponds to the @prefix@ variable in the +-- top-level Makefile and the /--prefix/ argument to the @configure@ script +-- at build time. The value is available to Python code as @sys.prefix@. It +-- is only useful on UNIX. See also 'getExecPrefix'. +-- +getPrefix :: IO Text +getPrefix = pyGetPrefix >>= peekTextW + +foreign import ccall safe "hscpython-shim.h Py_GetPrefix" + pyGetPrefix :: IO CWString + +-- | Return the /exec-prefix/ for installed platform-/dependent/ files. This +-- is derived through a number of complicated rules from the program name +-- set with setProgramName' and some environment variables; for example, if +-- the program name is @\"\/usr\/local\/bin\/python\"@, the exec-prefix is +-- @\"\/usr\/local\"@. This corresponds to the @exec_prefix@ variable in the +-- top-level Makefile and the /--exec-prefix/ argument to the @configure@ +-- script at build time. The value is available to Python code as +-- @sys.exec_prefix@. It is only useful on UNIX. +-- +-- Background: The exec-prefix differs from the prefix when platform +-- dependent files (such as executables and shared libraries) are installed +-- in a different directory tree. In a typical installation, platform +-- dependent files may be installed in the @\/usr\/local\/plat@ subtree while +-- platform independent may be installed in @\/usr\/local@. +-- +-- Generally speaking, a platform is a combination of hardware and software +-- families, e.g. Sparc machines running the Solaris 2.x operating system +-- are considered the same platform, but Intel machines running Solaris +-- 2.x are another platform, and Intel machines running Linux are yet +-- another platform. Different major revisions of the same operating system +-- generally also form different platforms. Non-UNIX operating systems are a +-- different story; the installation strategies on those systems are so +-- different that the prefix and exec-prefix are meaningless, and set to the +-- empty string. Note that compiled Python bytecode files are platform +-- independent (but not independent from the Python version by which they +-- were compiled!). +-- +-- System administrators will know how to configure the @mount@ or @automount@ +-- programs to share @\/usr\/local@ between platforms while having +-- @\/usr\/local\/plat@ be a different filesystem for each platform. +-- +getExecPrefix :: IO Text +getExecPrefix = pyGetExecPrefix >>= peekTextW + +foreign import ccall safe "hscpython-shim.h Py_GetExecPrefix" + pyGetExecPrefix :: IO CWString + +-- | Return the full program name of the Python executable; this is computed +-- as a side-effect of deriving the default module search path from the +-- program name (set by 'setProgramName' above). The value is available to +-- Python code as @sys.executable@. +-- +getProgramFullPath :: IO Text +getProgramFullPath = pyGetProgramFullPath >>= peekTextW + +foreign import ccall safe "hscpython-shim.h Py_GetProgramFullPath" + pyGetProgramFullPath :: IO CWString + +-- | Return the default module search path; this is computed from the +-- program name (set by 'setProgramName' above) and some environment +-- variables. The returned string consists of a series of directory names +-- separated by a platform dependent delimiter character. The delimiter +-- character is @\':\'@ on Unix and Mac OS X, @\';\'@ on Windows. The value +-- is available to Python code as the list @sys.path@, which may be modified +-- to change the future search path for loaded modules. +-- +getPath :: IO Text +getPath = pyGetPath >>= peekTextW + +foreign import ccall safe "hscpython-shim.h Py_GetPath" + pyGetPath :: IO CWString + +-- | Return the version of this Python interpreter. This is a string that +-- looks something like +-- +-- @ +-- \"3.0a5+ (py3k:63103M, May 12 2008, 00:53:55) \\n[GCC 4.2.3]\" +-- @ +-- +-- The first word (up to the first space character) is the current Python +-- version; the first three characters are the major and minor version +-- separated by a period. The value is available to Python code as +-- @sys.version@. +-- +{# fun Py_GetVersion as getVersion + {} -> `Text' peekText* #} + +-- | Return the platform identifier for the current platform. On Unix, this +-- is formed from the “official” name of the operating system, +-- converted to lower case, followed by the major revision number; e.g., for +-- Solaris 2.x, which is also known as SunOS 5.x, the value is @\"sunos5\"@. +-- On Mac OS X, it is @\"darwin\"@. On Windows, it is @\"win\"@. The value +-- is available to Python code as @sys.platform@. +-- +{# fun Py_GetPlatform as getPlatform + {} -> `Text' peekText* #} + +-- | Return the official copyright string for the current Python version, +-- for example +-- +-- @ +-- \"Copyright 1991-1995 Stichting Mathematisch Centrum, Amsterdam\" +-- @ +-- +-- The value is available to Python code as @sys.copyright@. +-- +{# fun Py_GetCopyright as getCopyright + {} -> `Text' peekText* #} + +-- | Return an indication of the compiler used to build the current Python +-- version, in square brackets, for example: +-- +-- @ +-- \"[GCC 2.7.2.2]\" +-- @ +-- +-- The value is available to Python code as part of the variable +-- @sys.version@. +-- +{# fun Py_GetCompiler as getCompiler + {} -> `Text' peekText* #} + +-- | Return information about the sequence number and build date and time of +-- the current Python interpreter instance, for example +-- +-- @ +-- \"#67, Aug 1 1997, 22:34:28\" +-- @ +-- +-- The value is available to Python code as part of the variable +-- @sys.version@. +-- +{# fun Py_GetBuildInfo as getBuildInfo + {} -> `Text' peekText* #} + +-- | Set @sys.argv@. The first parameter is similar to the result of +-- 'getProgName', with the difference that it should refer to the script +-- file to be executed rather than the executable hosting the Python +-- interpreter. If there isn’t a script that will be run, the first +-- parameter can be an empty string. If this function fails to initialize +-- @sys.argv@, a fatal condition is signalled using @Py_FatalError()@. +-- +-- This function also prepends the executed script’s path to +-- @sys.path@. If no script is executed (in the case of calling @python -c@ +-- or just the interactive interpreter), the empty string is used instead. +-- +setArgv :: Text -> [Text] -> IO () +setArgv argv0 argv = + mapWith withTextW (argv0 : argv) $ \textPtrs -> + let argc = fromIntegral $ length textPtrs in + withArray textPtrs $ pySetArgv argc + +foreign import ccall safe "hscpython-shim.h PySys_SetArgv" + pySetArgv :: CInt -> Ptr CWString -> IO () + +-- | Return the default “home”, that is, the value set by a +-- previous call to 'setPythonHome', or the value of the @PYTHONHOME@ +-- environment variable if it is set. +-- +getPythonHome :: IO Text +getPythonHome = pyGetPythonHome >>= peekTextW + +foreign import ccall safe "hscpython-shim.h Py_GetPythonHome" + pyGetPythonHome :: IO CWString + +-- | Set the default “home” directory, that is, the location +-- of the standard Python libraries. The libraries are searched in +-- @/home/\/lib\//python version/@ and @/home/\/lib\//python version/@. No +-- code in the Python interpreter will change the Python home. +-- +setPythonHome :: Text -> IO () +setPythonHome name = withTextW name cSetPythonHome + +foreign import ccall safe "hscpython-shim.h hscpython_SetPythonHome" + cSetPythonHome :: CWString -> IO () diff --git a/lib/CPython/Constants.chs b/lib/CPython/Constants.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Constants.chs @@ -0,0 +1,60 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Constants + ( none + , true + , false + , isNone + , isTrue + , isFalse + ) where +import CPython.Internal + +#include + +-- | The Python @None@ object, denoting lack of value. +-- +{# fun hscpython_Py_None as none + {} -> `SomeObject' peekObject* #} + +-- | The Python @True@ object. +-- +{# fun hscpython_Py_True as true + {} -> `SomeObject' peekObject* #} + +-- | The Python @False@ object. +-- +{# fun hscpython_Py_False as false + {} -> `SomeObject' peekObject* #} + +{# fun pure hscpython_Py_None as rawNone + {} -> `Ptr ()' id #} + +{# fun pure hscpython_Py_True as rawTrue + {} -> `Ptr ()' id #} + +{# fun pure hscpython_Py_False as rawFalse + {} -> `Ptr ()' id #} + +isNone :: SomeObject -> IO Bool +isNone obj = withObject obj $ \ptr -> return $ ptr == rawNone + +isTrue :: SomeObject -> IO Bool +isTrue obj = withObject obj $ \ptr -> return $ ptr == rawTrue + +isFalse :: SomeObject -> IO Bool +isFalse obj = withObject obj $ \ptr -> return $ ptr == rawFalse diff --git a/lib/CPython/Internal.chs b/lib/CPython/Internal.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Internal.chs @@ -0,0 +1,268 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE DeriveDataTypeable #-} +module CPython.Internal + ( + -- * FFI support + module Foreign + , module Foreign.C + , cToBool + , cFromBool + , peekText + , peekTextW + , withText + , withTextW + , mapWith + + -- * Fundamental types + , SomeObject (..) + , Type (..) + , Dictionary (..) + , List (..) + , Tuple (..) + + -- * Objects + , Object (..) + , Concrete (..) + , withObject + , peekObject + , peekStaticObject + , stealObject + , incref + , decref + , callObjectRaw + , unsafeCast + + -- * Exceptions + , Exception (..) + , exceptionIf + , checkStatusCode + , checkBoolReturn + , checkIntReturn + + -- * Other classes + -- ** Mapping + , Mapping (..) + , SomeMapping (..) + , unsafeCastToMapping + + -- ** Sequence + , Sequence (..) + , SomeSequence (..) + , unsafeCastToSequence + + -- ** Iterator + , Iterator (..) + , SomeIterator (..) + , unsafeCastToIterator + ) where +import Control.Applicative ((<$>)) +import qualified Control.Exception as E +import qualified Data.Text as T +import Data.Typeable (Typeable) +import Foreign +import Foreign.C + +#include + +cToBool :: CInt -> Bool +cToBool = (/= 0) + +cFromBool :: Bool -> CInt +cFromBool x = if x then 1 else 0 + +peekText :: CString -> IO T.Text +peekText = fmap T.pack . peekCString + +peekTextW :: CWString -> IO T.Text +peekTextW = fmap T.pack . peekCWString + +withText :: T.Text -> (CString -> IO a) -> IO a +withText = withCString . T.unpack + +withTextW :: T.Text -> (CWString -> IO a) -> IO a +withTextW = withCWString . T.unpack + +mapWith :: (a -> (b -> IO c) -> IO c) -> [a] -> ([b] -> IO c) -> IO c +mapWith with' = step [] where + step acc [] io = io acc + step acc (x:xs) io = with' x $ \y -> step (acc ++ [y]) xs io + +data SomeObject = forall a. (Object a) => SomeObject (ForeignPtr a) + +class Object a where + toObject :: a -> SomeObject + fromForeignPtr :: ForeignPtr a -> a + +class Object a => Concrete a where + concreteType :: a -> Type + +instance Object SomeObject where + toObject = id + fromForeignPtr = SomeObject + +newtype Type = Type (ForeignPtr Type) +instance Object Type where + toObject (Type x) = SomeObject x + fromForeignPtr = Type + +newtype Dictionary = Dictionary (ForeignPtr Dictionary) +instance Object Dictionary where + toObject (Dictionary x) = SomeObject x + fromForeignPtr = Dictionary + +newtype List = List (ForeignPtr List) +instance Object List where + toObject (List x) = SomeObject x + fromForeignPtr = List + +newtype Tuple = Tuple (ForeignPtr Tuple) +instance Object Tuple where + toObject (Tuple x) = SomeObject x + fromForeignPtr = Tuple + +withObject :: Object obj => obj -> (Ptr a -> IO b) -> IO b +withObject obj io = case toObject obj of + SomeObject ptr -> withForeignPtr ptr (io . castPtr) + +peekObject :: Object obj => Ptr a -> IO obj +peekObject ptr = E.bracketOnError incPtr decref mkObj where + incPtr = incref ptr >> return ptr + mkObj _ = fromForeignPtr <$> newForeignPtr staticDecref (castPtr ptr) + +peekStaticObject :: Object obj => Ptr a -> IO obj +peekStaticObject ptr = fromForeignPtr <$> newForeignPtr_ (castPtr ptr) + +unsafeStealObject :: Object obj => Ptr a -> IO obj +unsafeStealObject ptr = fromForeignPtr <$> newForeignPtr staticDecref (castPtr ptr) + +stealObject :: Object obj => Ptr a -> IO obj +stealObject ptr = exceptionIf (ptr == nullPtr) >> unsafeStealObject ptr + +{# fun hscpython_Py_INCREF as incref + { castPtr `Ptr a' + } -> `()' id #} + +{# fun hscpython_Py_DECREF as decref + { castPtr `Ptr a' + } -> `()' id #} + +foreign import ccall "hscpython-shim.h &hscpython_Py_DECREF" + staticDecref :: FunPtr (Ptr a -> IO ()) + +{# fun PyObject_CallObject as callObjectRaw + `(Object self, Object args)' => + { withObject* `self' + , withObject* `args' + } -> `SomeObject' stealObject* #} + +unsafeCast :: (Object a, Object b) => a -> b +unsafeCast a = case toObject a of + SomeObject ptr -> fromForeignPtr (castForeignPtr ptr) + +data Exception = Exception + { exceptionType :: SomeObject + , exceptionValue :: SomeObject + , exceptionTraceback :: Maybe SomeObject + } + deriving (Typeable) + +instance Show Exception where + show _ = "" + +instance E.Exception Exception + +exceptionIf :: Bool -> IO () +exceptionIf False = return () +exceptionIf True = + alloca $ \pType -> + alloca $ \pValue -> + alloca $ \pTrace -> do + {# call PyErr_Fetch as ^ #} pType pValue pTrace + {# call PyErr_NormalizeException as ^ #} pType pValue pTrace + eType <- unsafeStealObject =<< peek pType + eValue <- unsafeStealObject =<< peek pValue + eTrace <- maybePeek unsafeStealObject =<< peek pTrace + E.throwIO $ Exception eType eValue eTrace + +checkStatusCode :: CInt -> IO () +checkStatusCode = exceptionIf . (== -1) + +checkBoolReturn :: CInt -> IO Bool +checkBoolReturn x = do + exceptionIf $ x == -1 + return $ x /= 0 + +checkIntReturn :: Integral a => a -> IO Integer +checkIntReturn x = do + exceptionIf $ x == -1 + return $ toInteger x + +data SomeMapping = forall a. (Mapping a) => SomeMapping (ForeignPtr a) + +class Object a => Mapping a where + toMapping :: a -> SomeMapping + +instance Object SomeMapping where + toObject (SomeMapping x) = SomeObject x + fromForeignPtr = SomeMapping + +instance Mapping SomeMapping where + toMapping = id + +unsafeCastToMapping :: Object a => a -> SomeMapping +unsafeCastToMapping x = case toObject x of + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeMapping + in SomeMapping ptr' + +data SomeSequence = forall a. (Sequence a) => SomeSequence (ForeignPtr a) + +class Object a => Sequence a where + toSequence :: a -> SomeSequence + +instance Object SomeSequence where + toObject (SomeSequence x) = SomeObject x + fromForeignPtr = SomeSequence + +instance Sequence SomeSequence where + toSequence = id + +unsafeCastToSequence :: Object a => a -> SomeSequence +unsafeCastToSequence x = case toObject x of + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeSequence + in SomeSequence ptr' + +data SomeIterator = forall a. (Iterator a) => SomeIterator (ForeignPtr a) + +class Object a => Iterator a where + toIterator :: a -> SomeIterator + +instance Object SomeIterator where + toObject (SomeIterator x) = SomeObject x + fromForeignPtr = SomeIterator + +instance Iterator SomeIterator where + toIterator = id + +unsafeCastToIterator :: Object a => a -> SomeIterator +unsafeCastToIterator x = case toObject x of + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeIterator + in SomeIterator ptr' diff --git a/lib/CPython/Protocols/Iterator.chs b/lib/CPython/Protocols/Iterator.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Protocols/Iterator.chs @@ -0,0 +1,50 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Protocols.Iterator + ( Iterator (..) + , SomeIterator + , castToIterator + , next + ) where +import CPython.Internal + +#include + +-- | Attempt to convert an object to a generic 'Iterator'. If the object does +-- not implement the iterator protocol, returns 'Nothing'. +-- +castToIterator :: Object a => a -> IO (Maybe SomeIterator) +castToIterator obj = + withObject obj $ \objPtr -> do + isIter <- fmap cToBool $ {# call hscpython_PyIter_Check as ^ #} objPtr + return $ if isIter + then Just $ unsafeCastToIterator obj + else Nothing + +-- | Return the next value from the iteration, or 'Nothing' if there are no +-- remaining items. +-- +next :: Iterator iter => iter -> IO (Maybe SomeObject) +next iter = + withObject iter $ \iterPtr -> do + raw <- {# call PyIter_Next as ^ #} iterPtr + if raw == nullPtr + then do + err <- {# call PyErr_Occurred as ^ #} + exceptionIf $ err /= nullPtr + return Nothing + else fmap Just $ stealObject raw diff --git a/lib/CPython/Protocols/Mapping.chs b/lib/CPython/Protocols/Mapping.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Protocols/Mapping.chs @@ -0,0 +1,88 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Protocols.Mapping + ( Mapping (..) + , SomeMapping + , castToMapping + , getItem + , setItem + , deleteItem + , size + , hasKey + , keys + , values + , items + ) where +import CPython.Internal + +#include + +instance Mapping Dictionary where + toMapping = unsafeCastToMapping + +castToMapping :: Object a => a -> IO (Maybe SomeMapping) +castToMapping obj = + withObject obj $ \objPtr -> do + isMapping <- fmap cToBool $ {# call PyMapping_Check as ^ #} objPtr + return $ if isMapping + then Just $ unsafeCastToMapping obj + else Nothing + +{# fun PyObject_GetItem as getItem + `(Mapping self, Object key)' => + { withObject* `self' + , withObject* `key' + } -> `SomeObject' stealObject* #} + +{# fun PyObject_SetItem as setItem + `(Mapping self, Object key, Object value)' => + { withObject* `self' + , withObject* `key' + , withObject* `value' + } -> `()' checkStatusCode* #} + +{# fun PyObject_DelItem as deleteItem + `(Mapping self, Object key)' => + { withObject* `self' + , withObject* `key' + } -> `()' checkStatusCode* #} + +{# fun PyMapping_Size as size + `Mapping self' => + { withObject* `self' + } -> `Integer' checkIntReturn* #} + +{# fun PyMapping_HasKey as hasKey + `(Mapping self, Object key)' => + { withObject* `self' + , withObject* `key' + } -> `Bool' #} + +{# fun PyMapping_Keys as keys + `Mapping self' => + { withObject* `self' + } -> `List' stealObject* #} + +{# fun PyMapping_Values as values + `Mapping self' => + { withObject* `self' + } -> `List' stealObject* #} + +{# fun PyMapping_Items as items + `Mapping self' => + { withObject* `self' + } -> `List' stealObject* #} diff --git a/lib/CPython/Protocols/Number.chs b/lib/CPython/Protocols/Number.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Protocols/Number.chs @@ -0,0 +1,299 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ExistentialQuantification #-} +module CPython.Protocols.Number + ( Number (..) + , SomeNumber + , castToNumber + , add + , subtract + , multiply + , floorDivide + , trueDivide + , remainder + , divmod + , power + , negative + , positive + , absolute + , invert + , shiftL + , shiftR + , and + , xor + , or + , inPlaceAdd + , inPlaceSubtract + , inPlaceMultiply + , inPlaceFloorDivide + , inPlaceTrueDivide + , inPlaceRemainder + , inPlacePower + , inPlaceShiftL + , inPlaceShiftR + , inPlaceAnd + , inPlaceXor + , inPlaceOr + , toInteger + , toFloat + , toBase + ) where +import Prelude hiding (Integer, Float, subtract, and, or, toInteger) +import qualified Prelude as Prelude +import CPython.Internal hiding (xor, shiftR, shiftL) +import CPython.Constants (none) +import CPython.Types.Complex (Complex) +import CPython.Types.Float (Float) +import CPython.Types.Integer (Integer) +import CPython.Types.Unicode (Unicode) +import CPython.Types.Set (Set, FrozenSet) + +#include + +data SomeNumber = forall a. (Number a) => SomeNumber (ForeignPtr a) + +class Object a => Number a where + toNumber :: a -> SomeNumber + +instance Object SomeNumber where + toObject (SomeNumber x) = SomeObject x + fromForeignPtr = SomeNumber + +instance Number SomeNumber where + toNumber = id + +instance Number Integer where + toNumber = unsafeCastToNumber + +instance Number Float where + toNumber = unsafeCastToNumber + +instance Number Complex where + toNumber = unsafeCastToNumber + +-- lol wut +instance Number Set where + toNumber = unsafeCastToNumber + +instance Number FrozenSet where + toNumber = unsafeCastToNumber + +unsafeCastToNumber :: Object a => a -> SomeNumber +unsafeCastToNumber x = case toObject x of + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeNumber + in SomeNumber ptr' + +castToNumber :: Object a => a -> IO (Maybe SomeNumber) +castToNumber obj = + withObject obj $ \objPtr -> do + isNumber <- fmap cToBool $ {# call PyNumber_Check as ^ #} objPtr + return $ if isNumber + then Just $ unsafeCastToNumber obj + else Nothing + +{# fun PyNumber_Add as add + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Subtract as subtract + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Multiply as multiply + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_FloorDivide as floorDivide + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_TrueDivide as trueDivide + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Remainder as remainder + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Divmod as divmod + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +power :: (Number a, Number b, Number c) => a -> b -> Maybe c -> IO SomeNumber +power a b mc = + withObject a $ \aPtr -> + withObject b $ \bPtr -> + maybe none (return . toObject) mc >>= \c -> + withObject c $ \cPtr -> + {# call PyNumber_Power as ^ #} aPtr bPtr cPtr + >>= stealObject + +{# fun PyNumber_Negative as negative + `Number a' => + { withObject* `a' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Positive as positive + `Number a' => + { withObject* `a' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Absolute as absolute + `Number a' => + { withObject* `a' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Invert as invert + `Number a' => + { withObject* `a' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Lshift as shiftL + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Rshift as shiftR + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_And as and + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Xor as xor + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Or as or + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_InPlaceAdd as inPlaceAdd + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_InPlaceSubtract as inPlaceSubtract + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_InPlaceMultiply as inPlaceMultiply + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_InPlaceFloorDivide as inPlaceFloorDivide + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_InPlaceTrueDivide as inPlaceTrueDivide + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_InPlaceRemainder as inPlaceRemainder + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +inPlacePower ::(Number a, Number b, Number c) => a -> b -> Maybe c -> IO SomeNumber +inPlacePower a b mc = + withObject a $ \aPtr -> + withObject b $ \bPtr -> + maybe none (return . toObject) mc >>= \c -> + withObject c $ \cPtr -> + {# call PyNumber_InPlacePower as ^ #} aPtr bPtr cPtr + >>= stealObject + +{# fun PyNumber_InPlaceLshift as inPlaceShiftL + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_InPlaceRshift as inPlaceShiftR + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_InPlaceAnd as inPlaceAnd + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_InPlaceXor as inPlaceXor + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_InPlaceOr as inPlaceOr + `(Number a, Number b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeNumber' stealObject* #} + +{# fun PyNumber_Long as toInteger + `Number a' => + { withObject* `a' + } -> `Integer' stealObject* #} + +{# fun PyNumber_Float as toFloat + `Number a' => + { withObject* `a' + } -> `Float' stealObject* #} + +{# fun PyNumber_ToBase as toBase + `Number a' => + { withObject* `a' + , fromIntegral `Prelude.Integer' + } -> `Unicode' stealObject* #} diff --git a/lib/CPython/Protocols/Object.chs b/lib/CPython/Protocols/Object.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Protocols/Object.chs @@ -0,0 +1,317 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Protocols.Object + ( Object + , Concrete + , SomeObject + + -- * Types and casting + , getType + , isInstance + , isSubclass + , toObject + , cast + + -- * Attributes + , hasAttribute + , getAttribute + , setAttribute + , deleteAttribute + + -- * Display and debugging + , print + , repr + , ascii + , string + , bytes + + -- * Callables + , callable + , call + , callArgs + , callMethod + , callMethodArgs + + -- * Misc + , Comparison (..) + , richCompare + , toBool + , hash + , dir + , getIterator + ) where +import Prelude hiding (Ordering (..), print) +import qualified Data.Text as T +import System.IO (Handle, hPutStrLn) +import CPython.Internal hiding (toBool) +import qualified CPython.Types.Bytes as B +import qualified CPython.Types.Dictionary as D +import qualified CPython.Types.Tuple as Tuple +import qualified CPython.Types.Unicode as U + +#include + +-- | Returns a 'Type' object corresponding to the object type of /self/. On +-- failure, throws @SystemError@. This is equivalent to the Python expression +-- @type(o)@. +-- +{# fun PyObject_Type as getType + `Object self' => + { withObject* `self' + } -> `Type' stealObject* #} + +-- | Returns 'True' if /inst/ is an instance of the class /cls/ or a +-- subclass of /cls/, or 'False' if not. On error, throws an exception. +-- If /cls/ is a type object rather than a class object, 'isInstance' +-- returns 'True' if /inst/ is of type /cls/. If /cls/ is a tuple, the check +-- will be done against every entry in /cls/. The result will be 'True' when +-- at least one of the checks returns 'True', otherwise it will be 'False'. If +-- /inst/ is not a class instance and /cls/ is neither a type object, nor a +-- class object, nor a tuple, /inst/ must have a @__class__@ attribute ߞ +-- the class relationship of the value of that attribute with /cls/ will be +-- used to determine the result of this function. +-- +-- Subclass determination is done in a fairly straightforward way, but +-- includes a wrinkle that implementors of extensions to the class system +-- may want to be aware of. If A and B are class objects, B is a subclass of +-- A if it inherits from A either directly or indirectly. If either is not a +-- class object, a more general mechanism is used to determine the class +-- relationship of the two objects. When testing if B is a subclass of A, if +-- A is B, 'isSubclass' returns 'True'. If A and B are different objects, +-- Bߢs @__bases__@ attribute is searched in a depth-first fashion for +-- A ߞ the presence of the @__bases__@ attribute is considered +-- sufficient for this determination. +-- +{# fun PyObject_IsInstance as isInstance + `(Object self, Object cls)' => + { withObject* `self' + , withObject* `cls' + } -> `Bool' checkBoolReturn* #} + +-- | Returns 'True' if the class /derived/ is identical to or derived from +-- the class /cls/, otherwise returns 'False'. In case of an error, throws +-- an exception. If /cls/ is a tuple, the check will be done against every +-- entry in /cls/. The result will be 'True' when at least one of the checks +-- returns 'True', otherwise it will be 'False'. If either /derived/ or /cls/ +-- is not an actual class object (or tuple), this function uses the generic +-- algorithm described above. +-- +{# fun PyObject_IsSubclass as isSubclass + `(Object derived, Object cls)' => + { withObject* `derived' + , withObject* `cls' + } -> `Bool' checkBoolReturn* #} + +-- | Attempt to cast an object to some concrete class. If the object +-- isn't an instance of the class or subclass, returns 'Nothing'. +-- +cast :: (Object a, Concrete b) => a -> IO (Maybe b) +cast obj = do + let castObj = case toObject obj of + SomeObject ptr -> fromForeignPtr $ castForeignPtr ptr + validCast <- isInstance obj $ concreteType castObj + return $ if validCast + then Just castObj + else Nothing + +-- | Returns 'True' if /self/ has an attribute with the given name, and +-- 'False' otherwise. This is equivalent to the Python expression +-- @hasattr(self, name)@ +-- +{# fun PyObject_HasAttr as hasAttribute + `Object self' => + { withObject* `self' + , withObject* `U.Unicode' + } -> `Bool' checkBoolReturn* #} + +-- | Retrieve an attribute with the given name from object /self/. Returns +-- the attribute value on success, and throws an exception on failure. This +-- is the equivalent of the Python expression @self.name@. +-- +{# fun PyObject_GetAttr as getAttribute + `Object self' => + { withObject* `self' + , withObject* `U.Unicode' + } -> `SomeObject' stealObject* #} + +-- | Set the value of the attribute with the given name, for object /self/, +-- to the value /v/. THrows an exception on failure. This is the equivalent +-- of the Python statement @self.name = v@. +-- +{# fun PyObject_SetAttr as setAttribute + `(Object self, Object v)' => + { withObject* `self' + , withObject* `U.Unicode' + , withObject* `v' + } -> `()' checkStatusCode* #} + +-- | Delete an attribute with the given name, for object /self/. Throws an +-- exception on failure. This is the equivalent of the Python statement +-- @del self.name@. +-- +{# fun hscpython_PyObject_DelAttr as deleteAttribute + `Object self' => + { withObject* `self' + , withObject* `U.Unicode' + } -> `()' checkStatusCode* #} + +-- | Print @repr(self)@ to a handle. +-- +print :: Object self => self -> Handle -> IO () +print obj h = repr obj >>= U.fromUnicode >>= (hPutStrLn h . T.unpack) + +-- | Compute a string representation of object /self/, or throw an exception +-- on failure. This is the equivalent of the Python expression @repr(self)@. +-- +{# fun PyObject_Repr as repr + `Object self' => + { withObject* `self' + } -> `U.Unicode' stealObject* #} + +-- \ As 'ascii', compute a string representation of object /self/, but escape +-- the non-ASCII characters in the string returned by 'repr' with @\x@, @\u@ +-- or @\U@ escapes. This generates a string similar to that returned by +-- 'repr' in Python 2. +-- +{# fun PyObject_ASCII as ascii + `Object self' => + { withObject* `self' + } -> `U.Unicode' stealObject* #} + +-- | Compute a string representation of object /self/, or throw an exception +-- on failure. This is the equivalent of the Python expression @str(self)@. +-- +{# fun PyObject_Str as string + `Object self' => + { withObject* `self' + } -> `U.Unicode' stealObject* #} + +-- | Compute a bytes representation of object /self/, or throw an exception +-- on failure. This is equivalent to the Python expression @bytes(self)@. +-- +{# fun PyObject_Bytes as bytes + `Object self' => + { withObject* `self' + } -> `B.Bytes' stealObject* #} + +-- | Determine if the object /self/ is callable. +-- +{# fun PyCallable_Check as callable + `Object self' => + { withObject* `self' + } -> `Bool' checkBoolReturn* #} + +-- | Call a callable Python object /self/, with arguments given by the +-- tuple and named arguments given by the dictionary. Returns the result of +-- the call on success, or throws an exception on failure. This is the +-- equivalent of the Python expression @self(*args, **kw)@. +-- +call :: Object self => self -> Tuple -> Dictionary -> IO SomeObject +call self args kwargs = + withObject self $ \selfPtr -> + withObject args $ \argsPtr -> + withObject kwargs $ \kwargsPtr -> + {# call PyObject_Call as ^ #} selfPtr argsPtr kwargsPtr + >>= stealObject + +-- | Call a callable Python object /self/, with arguments given by the list. +-- +callArgs :: Object self => self -> [SomeObject] -> IO SomeObject +callArgs self args = do + args' <- Tuple.toTuple args + D.new >>= call self args' + +-- | Call the named method of object /self/, with arguments given by the +-- tuple and named arguments given by the dictionary. Returns the result of +-- the call on success, or throws an exception on failure. This is the +-- equivalent of the Python expression @self.method(args)@. +-- +callMethod :: Object self => self -> T.Text -> Tuple -> Dictionary -> IO SomeObject +callMethod self name args kwargs = do + method <- getAttribute self =<< U.toUnicode name + call method args kwargs + +-- | Call the named method of object /self/, with arguments given by the +-- list. Returns the result of the call on success, or throws an exception +-- on failure. This is the equivalent of the Python expression +-- @self.method(args)@. +-- +callMethodArgs :: Object self => self -> T.Text -> [SomeObject] -> IO SomeObject +callMethodArgs self name args = do + args' <- Tuple.toTuple args + D.new >>= callMethod self name args' + +data Comparison = LT | LE | EQ | NE | GT | GE + deriving (Show) + +{# enum HSCPythonComparisonEnum {} #} + +comparisonToInt :: Comparison -> CInt +comparisonToInt = fromIntegral . fromEnum . enum where + enum LT = HSCPYTHON_LT + enum LE = HSCPYTHON_LE + enum EQ = HSCPYTHON_EQ + enum NE = HSCPYTHON_NE + enum GT = HSCPYTHON_GT + enum GE = HSCPYTHON_GE + +-- | Compare the values of /a/ and /b/ using the specified comparison. +-- If an exception is raised, throws an exception. +-- +{# fun PyObject_RichCompareBool as richCompare + `(Object a, Object b)' => + { withObject* `a' + , withObject* `b' + , comparisonToInt `Comparison' + } -> `Bool' checkBoolReturn* #} + +-- | Returns 'True' if the object /self/ is considered to be true, and 'False' +-- otherwise. This is equivalent to the Python expression @not not self@. On +-- failure, throws an exception. +-- +{# fun PyObject_IsTrue as toBool + `Object self' => + { withObject* `self' + } -> `Bool' checkBoolReturn* #} + +-- | Compute and return the hash value of an object /self/. On failure, +-- throws an exception. This is the equivalent of the Python expression +-- @hash(self)@. +-- +{# fun PyObject_Hash as hash + `Object self' => + { withObject* `self' + } -> `Integer' checkIntReturn* #} + +-- | This is equivalent to the Python expression @dir(self)@, returning a +-- (possibly empty) list of strings appropriate for the object argument, +-- or throws an exception if there was an error. +-- +{# fun PyObject_Dir as dir + `Object self' => + { withObject* `self' + } -> `List' stealObject* #} + +-- | This is equivalent to the Python expression @iter(self)@. It returns a +-- new iterator for the object argument, or the object itself if the object +-- is already an iterator. Throws @TypeError@ if the object cannot be +-- iterated. +-- +{# fun PyObject_GetIter as getIterator + `Object self' => + { withObject* `self' + } -> `SomeObject' stealObject* #} diff --git a/lib/CPython/Protocols/Sequence.chs b/lib/CPython/Protocols/Sequence.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Protocols/Sequence.chs @@ -0,0 +1,189 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Protocols.Sequence + ( Sequence (..) + , SomeSequence + , castToSequence + , length + , append + , repeat + , inPlaceAppend + , inPlaceRepeat + , getItem + , setItem + , deleteItem + , getSlice + , setSlice + , deleteSlice + , count + , contains + , index + , toList + , toTuple + , fast + ) where +import Prelude hiding (repeat, length) +import Data.Text (Text) +import CPython.Internal +import CPython.Types.ByteArray (ByteArray) +import CPython.Types.Bytes (Bytes) +import CPython.Types.Unicode (Unicode) + +#include + +instance Sequence ByteArray where + toSequence = unsafeCastToSequence + +instance Sequence Bytes where + toSequence = unsafeCastToSequence + +instance Sequence List where + toSequence = unsafeCastToSequence + +instance Sequence Tuple where + toSequence = unsafeCastToSequence + +instance Sequence Unicode where + toSequence = unsafeCastToSequence + +-- | Attempt to convert an object to a generic 'Sequence'. If the object does +-- not implement the sequence protocol, returns 'Nothing'. +-- +castToSequence :: Object a => a -> IO (Maybe SomeSequence) +castToSequence obj = + withObject obj $ \objPtr -> do + isSequence <- fmap cToBool $ {# call PySequence_Check as ^ #} objPtr + return $ if isSequence + then Just $ unsafeCastToSequence obj + else Nothing + +{# fun PySequence_Size as length + `Sequence self' => + { withObject* `self' + } -> `Integer' checkIntReturn* #} + +{# fun PySequence_Concat as append + `(Sequence a, Sequence b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeSequence' stealObject* #} + +{# fun PySequence_Repeat as repeat + `Sequence a' => + { withObject* `a' + , fromIntegral `Integer' + } -> `a' stealObject* #} + +{# fun PySequence_InPlaceConcat as inPlaceAppend + `(Sequence a, Sequence b)' => + { withObject* `a' + , withObject* `b' + } -> `SomeSequence' stealObject* #} + +{# fun PySequence_InPlaceRepeat as inPlaceRepeat + `Sequence a' => + { withObject* `a' + , fromIntegral `Integer' + } -> `a' stealObject* #} + +{# fun PySequence_GetItem as getItem + `Sequence self' => + { withObject* `self' + , fromIntegral `Integer' + } -> `SomeObject' stealObject* #} + +{# fun PySequence_SetItem as setItem + `(Sequence self, Object v)' => + { withObject* `self' + , fromIntegral `Integer' + , withObject* `v' + } -> `()' checkStatusCode* #} + +{# fun PySequence_DelItem as deleteItem + `Sequence self' => + { withObject* `self' + , fromIntegral `Integer' + } -> `()' checkStatusCode* #} + +{# fun PySequence_GetSlice as getSlice + `Sequence self' => + { withObject* `self' + , fromIntegral `Integer' + , fromIntegral `Integer' + } -> `SomeObject' stealObject* #} + +{# fun PySequence_SetSlice as setSlice + `(Sequence self, Object v)' => + { withObject* `self' + , fromIntegral `Integer' + , fromIntegral `Integer' + , withObject* `v' + } -> `()' checkStatusCode* #} + +{# fun PySequence_DelSlice as deleteSlice + `Sequence self' => + { withObject* `self' + , fromIntegral `Integer' + , fromIntegral `Integer' + } -> `()' checkStatusCode* #} + +{# fun PySequence_Count as count + `(Sequence self, Object v)' => + { withObject* `self' + , withObject* `v' + } -> `Integer' checkIntReturn* #} + +{# fun PySequence_Contains as contains + `(Sequence self, Object v)' => + { withObject* `self' + , withObject* `v' + } -> `Bool' checkBoolReturn* #} + +-- | Return the first index /i/ for which @self[i] == v@. This is equivalent +-- to the Python expression @self.index(v)@. +-- +{# fun PySequence_Index as index + `(Sequence self, Object v)' => + { withObject* `self' + , withObject* `v' + } -> `Integer' checkIntReturn* #} + +-- | Return a list object with the same contents as the arbitrary sequence +-- /seq/. The returned list is guaranteed to be new. +-- +{# fun PySequence_List as toList + `Sequence seq' => + { withObject* `seq' + } -> `List' stealObject* #} + +-- | Return a tuple object with the same contents as the arbitrary sequence +-- /seq/. If /seq/ is already a tuple, it is re-used rather than copied. +-- +{# fun PySequence_Tuple as toTuple + `Sequence seq' => + { withObject* `seq' + } -> `Tuple' stealObject* #} + +-- | Returns the sequence /seq/ as a tuple, unless it is already a tuple or +-- list, in which case /seq/ is returned. If an error occurs, throws +-- @TypeError@ with the given text as the exception text. +-- +{# fun PySequence_Fast as fast + `Sequence seq' => + { withObject* `seq' + , withText* `Text' + } -> `SomeSequence' stealObject* #} diff --git a/lib/CPython/Reflection.chs b/lib/CPython/Reflection.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Reflection.chs @@ -0,0 +1,70 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Reflection + ( getBuiltins + , getLocals + , getGlobals + , getFrame + , getFunctionName + , getFunctionDescription + ) where +import Data.Text (Text) +import CPython.Internal + +#include + +-- | Return a 'Dictionary' of the builtins in the current execution frame, +-- or the interpreter of the thread state if no frame is currently executing. +-- +{# fun PyEval_GetBuiltins as getBuiltins + {} -> `Dictionary' peekObject* #} + +-- | Return a 'Dictionary' of the local variables in the current execution +-- frame, or 'Nothing' if no frame is currently executing. +-- +getLocals :: IO (Maybe Dictionary) +getLocals = {# call PyEval_GetLocals as ^#} >>= maybePeek peekObject + +-- | Return a 'Dictionary' of the global variables in the current execution +-- frame, or 'Nothing' if no frame is currently executing. +-- +getGlobals :: IO (Maybe Dictionary) +getGlobals = {# call PyEval_GetGlobals as ^#} >>= maybePeek peekObject + +-- | Return the current thread state's frame, which is 'Nothing' if no frame +-- is currently executing. +-- +getFrame :: IO (Maybe SomeObject) +getFrame = {# call PyEval_GetFrame as ^#} >>= maybePeek peekObject + +-- | Return the name of /func/ if it is a function, class or instance object, +-- else the name of /func/'s type. +-- +{# fun PyEval_GetFuncName as getFunctionName + `Object func' => + { withObject* `func' + } -> `Text' peekText* #} + +-- | Return a description string, depending on the type of func. Return +-- values include @\"()\"@ for functions and methods, @\"constructor\"@, +-- @\"instance\"@, and @\"object\"@. Concatenated with the result of +-- 'getFunctionName', the result will be a description of /func/. +-- +{# fun PyEval_GetFuncDesc as getFunctionDescription + `Object func' => + { withObject* `func' + } -> `Text' peekText* #} diff --git a/lib/CPython/System.chs b/lib/CPython/System.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/System.chs @@ -0,0 +1,79 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.System + ( getObject + , setObject + , deleteObject + , resetWarnOptions + , addWarnOption + , setPath + ) where +import Data.Text (Text) +import CPython.Internal + +#include + +-- | Return the object /name/ from the @sys@ module, or 'Nothing' if it does +-- not exist. +-- +getObject :: Text -> IO (Maybe SomeObject) +getObject name = + withText name $ \cstr -> do + raw <- {# call PySys_GetObject as ^ #} cstr + maybePeek peekObject raw + +-- getFile + +-- | Set /name/ in the @sys@ module to a value. +-- +setObject :: Object a => Text -> a -> IO () +setObject name v = + withText name $ \cstr -> + withObject v $ \vPtr -> + {# call PySys_SetObject as ^ #} cstr vPtr + >>= checkStatusCode + +-- | Delete /name/ from the @sys@ module. +-- +deleteObject :: Text -> IO () +deleteObject name = + withText name $ \cstr -> + {# call PySys_SetObject as ^ #} cstr nullPtr + >>= checkStatusCode + +-- | Reset @sys.warnoptions@ to an empty list. +-- +{# fun PySys_ResetWarnOptions as resetWarnOptions + {} -> `()' id #} + +-- | Add an entry to @sys.warnoptions@. +-- +addWarnOption :: Text -> IO () +addWarnOption str = withTextW str pySysAddWarnOption + +foreign import ccall safe "hscpython-shim.h PySys_AddWarnOption" + pySysAddWarnOption :: CWString -> IO () + +-- | Set @sys.path@ to a list object of paths found in the parameter, which +-- should be a list of paths separated with the platform's search path +-- delimiter (@\':\'@ on Unix, @\';\'@ on Windows). +-- +setPath :: Text -> IO () +setPath path = withTextW path pySysSetPath + +foreign import ccall safe "hscpython-shim.h PySys_SetPath" + pySysSetPath :: CWString -> IO () diff --git a/lib/CPython/Types.hs b/lib/CPython/Types.hs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types.hs @@ -0,0 +1,116 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +module CPython.Types + ( + -- * Types and classes + ByteArray + , Bytes + , Capsule + , Cell + , Code + , Complex + , Dictionary + , Exception + , CPython.Types.Float.Float + , Function + , InstanceMethod + , CPython.Types.Integer.Integer + , SequenceIterator + , CallableIterator + , List + , Method + , Module + , AnySet + , Set + , FrozenSet + , Slice + , Tuple + , Type + , Unicode + , Reference + , Proxy + + -- * Python 'Type' values + , byteArrayType + , bytesType + , capsuleType + , cellType + , codeType + , complexType + , dictionaryType + , floatType + , functionType + , instanceMethodType + , integerType + , sequenceIteratorType + , callableIteratorType + , listType + , methodType + , moduleType + , setType + , frozenSetType + , sliceType + , tupleType + , typeType + , unicodeType + + -- * Building and parsing values + , toByteArray + , fromByteArray + , toBytes + , fromBytes + , toComplex + , fromComplex + , toFloat + , fromFloat + , CPython.Types.Integer.toInteger + , CPython.Types.Integer.fromInteger + , toList + , iterableToList + , fromList + , toSet + , toFrozenSet + , iterableToSet + , iterableToFrozenSet + , fromSet + , CPython.Types.Tuple.toTuple + , iterableToTuple + , fromTuple + , toUnicode + , fromUnicode + ) where +import CPython.Types.ByteArray +import CPython.Types.Bytes +import CPython.Types.Capsule +import CPython.Types.Cell +import CPython.Types.Code +import CPython.Types.Complex +import CPython.Types.Dictionary +import CPython.Types.Exception +import CPython.Types.Float +import CPython.Types.Function +import CPython.Types.InstanceMethod +import CPython.Types.Integer +import CPython.Types.Iterator +import CPython.Types.List +import CPython.Types.Method +import CPython.Types.Module +import CPython.Types.Set +import CPython.Types.Slice +import CPython.Types.Tuple +import CPython.Types.Type +import CPython.Types.Unicode +import CPython.Types.WeakReference diff --git a/lib/CPython/Types/ByteArray.chs b/lib/CPython/Types/ByteArray.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/ByteArray.chs @@ -0,0 +1,79 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.ByteArray + ( ByteArray + , byteArrayType + , toByteArray + , fromByteArray + , fromObject + , append + , length + , resize + ) where +import Prelude hiding (length) +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import CPython.Internal + +#include + +newtype ByteArray = ByteArray (ForeignPtr ByteArray) + +instance Object ByteArray where + toObject (ByteArray x) = SomeObject x + fromForeignPtr = ByteArray + +instance Concrete ByteArray where + concreteType _ = byteArrayType + +{# fun pure hscpython_PyByteArray_Type as byteArrayType + {} -> `Type' peekStaticObject* #} + +toByteArray :: B.ByteString -> IO ByteArray +toByteArray bytes = let + mkByteArray = {# call PyByteArray_FromStringAndSize as ^ #} + in B.unsafeUseAsCStringLen bytes $ \(cstr, len) -> + stealObject =<< mkByteArray cstr (fromIntegral len) + +fromByteArray :: ByteArray -> IO B.ByteString +fromByteArray py = + withObject py $ \pyPtr -> do + size' <- {# call PyByteArray_Size as ^ #} pyPtr + bytes <- {# call PyByteArray_AsString as ^ #} pyPtr + B.packCStringLen (bytes, fromIntegral size') + +-- | Create a new byte array from any object which implements the buffer +-- protocol. +-- +{# fun PyByteArray_FromObject as fromObject + `Object self ' => + { withObject* `self' + } -> `ByteArray' stealObject* #} + +{# fun PyByteArray_Concat as append + { withObject* `ByteArray' + , withObject* `ByteArray' + } -> `ByteArray' stealObject* #} + +{# fun PyByteArray_Size as length + { withObject* `ByteArray' + } -> `Integer' checkIntReturn* #} + +{# fun PyByteArray_Resize as resize + { withObject* `ByteArray' + , fromIntegral `Integer' + } -> `()' checkStatusCode* #} diff --git a/lib/CPython/Types/Bytes.chs b/lib/CPython/Types/Bytes.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Bytes.chs @@ -0,0 +1,84 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Bytes + ( Bytes + , bytesType + , toBytes + , fromBytes + , fromObject + , length + , append + ) where +import Prelude hiding (length) +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import CPython.Internal + +#include + +newtype Bytes = Bytes (ForeignPtr Bytes) + +instance Object Bytes where + toObject (Bytes x) = SomeObject x + fromForeignPtr = Bytes + +instance Concrete Bytes where + concreteType _ = bytesType + +{# fun pure hscpython_PyBytes_Type as bytesType + {} -> `Type' peekStaticObject* #} + +toBytes :: B.ByteString -> IO Bytes +toBytes bytes = let + mkBytes = {# call PyBytes_FromStringAndSize as ^ #} + in B.unsafeUseAsCStringLen bytes $ \(cstr, len) -> + stealObject =<< mkBytes cstr (fromIntegral len) + +fromBytes :: Bytes -> IO B.ByteString +fromBytes py = + alloca $ \bytesPtr -> + alloca $ \lenPtr -> + withObject py $ \pyPtr -> do + {# call PyBytes_AsStringAndSize as ^ #} pyPtr bytesPtr lenPtr + >>= checkStatusCode + bytes <- peek bytesPtr + len <- peek lenPtr + B.packCStringLen (bytes, fromIntegral len) + +-- | Create a new byte string from any object which implements the buffer +-- protocol. +-- +{# fun PyBytes_FromObject as fromObject + `Object self ' => + { withObject* `self' + } -> `Bytes' stealObject* #} + +{# fun PyBytes_Size as length + { withObject* `Bytes' + } -> `Integer' checkIntReturn* #} + +append :: Bytes -> Bytes -> IO Bytes +append self next = + alloca $ \tempPtr -> + withObject self $ \selfPtr -> do + incref selfPtr + poke tempPtr selfPtr + withObject next $ \nextPtr -> do + {# call PyBytes_Concat as ^ #} tempPtr nextPtr + newSelf <- peek tempPtr + stealObject newSelf + diff --git a/lib/CPython/Types/Capsule.chs b/lib/CPython/Types/Capsule.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Capsule.chs @@ -0,0 +1,155 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Capsule + ( Capsule + , capsuleType + --, new + , getPointer + --, getDestructor + , getContext + , getName + , importNamed + , isValid + , setPointer + --, setDestructor + , setContext + --, setName + ) where +import Data.Text (Text) +import CPython.Internal hiding (new) + +#include + +-- type Destructor = Ptr () -> IO () +newtype Capsule = Capsule (ForeignPtr Capsule) + +instance Object Capsule where + toObject (Capsule x) = SomeObject x + fromForeignPtr = Capsule + +instance Concrete Capsule where + concreteType _ = capsuleType + +{# fun pure hscpython_PyCapsule_Type as capsuleType + {} -> `Type' peekStaticObject* #} + +-- new :: Ptr () -> Maybe Text -> Destructor -> IO Capsule +-- new = undefined + +-- | Retrieve the pointer stored in the capsule. On failure, throws an +-- exception. +-- +-- The name parameter must compare exactly to the name stored in the capsule. +-- If the name stored in the capsule is 'Nothing', the name passed in must +-- also be 'Nothing'. Python uses the C function strcmp() to compare capsule +-- names. +-- +getPointer :: Capsule -> Maybe Text -> IO (Ptr ()) +getPointer py name = + withObject py $ \pyPtr -> + maybeWith withText name $ \namePtr -> + {# call PyCapsule_GetPointer as ^ #} pyPtr namePtr + +-- getDestructor :: Capsule -> IO (Maybe Destructor) +-- getDestructor = undefined + +-- | Return the current context stored in the capsule, which might be @NULL@. +-- +getContext :: Capsule -> IO (Ptr ()) +getContext py = + withObject py $ \pyPtr -> do + {# call PyErr_Clear as ^ #} + ptr <- {# call PyCapsule_GetContext as ^ #} pyPtr + if ptr /= nullPtr + then return ptr + else do + exc <- {# call PyErr_Occurred as ^ #} + exceptionIf $ exc /= nullPtr + return ptr + +-- | Return the current name stored in the capsule, which might be 'Nothing'. +-- +getName :: Capsule -> IO (Maybe Text) +getName py = + withObject py $ \pyPtr -> do + {# call PyErr_Clear as ^ #} + ptr <- {# call PyCapsule_GetName as ^ #} pyPtr + if ptr /= nullPtr + then Just `fmap` peekText ptr + else do + exc <- {# call PyErr_Occurred as ^ #} + exceptionIf $ exc /= nullPtr + return Nothing + +-- | Import a pointer to a C object from a capsule attribute in a module. +-- The name parameter should specify the full name to the attribute, as in +-- @\"module.attribute\"@. The name stored in the capsule must match this +-- string exactly. If the second parameter is 'False', import the module +-- without blocking (using @PyImport_ImportModuleNoBlock()@). Otherwise, +-- imports the module conventionally (using @PyImport_ImportModule()@). +-- +-- Return the capsule’s internal pointer on success. On failure, throw +-- an exception. If the module could not be imported, and if importing in +-- non-blocking mode, returns 'Nothing'. +-- +importNamed :: Text -> Bool -> IO (Maybe (Ptr ())) +importNamed name block = + withText name $ \namePtr -> + let noBlock = cFromBool (not block) in do + {# call PyErr_Clear as ^ #} + ptr <- {# call PyCapsule_Import as ^ #} namePtr noBlock + if ptr /= nullPtr + then return $ Just ptr + else do + exc <- {# call PyErr_Occurred as ^ #} + exceptionIf $ exc /= nullPtr + return Nothing + +-- | Determines whether or not a capsule is valid. A valid capsule's type is +-- 'capsuleType', has a non-NULL pointer stored in it, and its internal name +-- matches the name parameter. (See 'getPointer' for information on how +-- capsule names are compared.) +-- +-- In other words, if 'isValid' returns 'True', calls to any of the +-- accessors (any function starting with @get@) are guaranteed to succeed. +-- +isValid :: Capsule -> Maybe Text -> IO Bool +isValid py name = + withObject py $ \pyPtr -> + maybeWith withText name $ \namePtr -> + {# call PyCapsule_IsValid as ^ #} pyPtr namePtr + >>= checkBoolReturn + +-- | Set the void pointer inside the capsule. The pointer may not be @NULL@. +-- +{# fun PyCapsule_SetPointer as setPointer + { withObject* `Capsule' + , id `Ptr ()' + } -> `()' checkStatusCode* #} + +-- setDestructor :: Capsule -> Maybe Destructor -> IO () +-- setDestructor = undefined + +-- | Set the context pointer inside the capsule. +-- +{# fun PyCapsule_SetContext as setContext + { withObject* `Capsule' + , id `Ptr ()' + } -> `()' checkStatusCode* #} + +-- setName :: Capsule -> Maybe Text -> IO () +-- setName = undefined diff --git a/lib/CPython/Types/Cell.chs b/lib/CPython/Types/Cell.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Cell.chs @@ -0,0 +1,64 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Cell + ( Cell + , cellType + , new + , get + , set + ) where +import CPython.Internal hiding (new) + +#include + +newtype Cell = Cell (ForeignPtr Cell) + +instance Object Cell where + toObject (Cell x) = SomeObject x + fromForeignPtr = Cell + +instance Concrete Cell where + concreteType _ = cellType + +{# fun pure hscpython_PyCell_Type as cellType + {} -> `Type' peekStaticObject* #} + +-- | Create and return a new cell containing the value /obj/. +-- +new :: Object obj => Maybe obj -> IO Cell +new obj = + maybeWith withObject obj $ \objPtr -> + {# call PyCell_New as ^ #} objPtr + >>= stealObject + +-- | Return the contents of a cell. +-- +get :: Cell -> IO (Maybe SomeObject) +get cell = + withObject cell $ \cellPtr -> + {# call PyCell_Get as ^ #} cellPtr + >>= maybePeek stealObject + +-- | Set the contents of a cell to /obj/. This releases the reference to any +-- current content of the cell. +-- +set :: Object obj => Cell -> Maybe obj -> IO () +set cell obj = + withObject cell $ \cellPtr -> + maybeWith withObject obj $ \objPtr -> + {# call PyCell_Set as ^ #} cellPtr objPtr + >>= checkStatusCode diff --git a/lib/CPython/Types/Code.chs b/lib/CPython/Types/Code.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Code.chs @@ -0,0 +1,35 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Code + ( Code + , codeType + ) where +import CPython.Internal + +#include + +newtype Code = Code (ForeignPtr Code) + +instance Object Code where + toObject (Code x) = SomeObject x + fromForeignPtr = Code + +instance Concrete Code where + concreteType _ = codeType + +{# fun pure hscpython_PyCode_Type as codeType + {} -> `Type' peekStaticObject* #} diff --git a/lib/CPython/Types/Complex.chs b/lib/CPython/Types/Complex.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Complex.chs @@ -0,0 +1,50 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Complex + ( Complex + , complexType + , toComplex + , fromComplex + ) where +import qualified Data.Complex as C +import CPython.Internal + +#include + +newtype Complex = Complex (ForeignPtr Complex) + +instance Object Complex where + toObject (Complex x) = SomeObject x + fromForeignPtr = Complex + +instance Concrete Complex where + concreteType _ = complexType + +{# fun pure hscpython_PyComplex_Type as complexType + {} -> `Type' peekStaticObject* #} + +toComplex :: C.Complex Double -> IO Complex +toComplex x = raw >>= stealObject where + real = realToFrac $ C.realPart x + imag = realToFrac $ C.imagPart x + raw = {# call PyComplex_FromDoubles as ^ #} real imag + +fromComplex :: Complex -> IO (C.Complex Double) +fromComplex py = withObject py $ \pyPtr -> do + real <- {# call PyComplex_RealAsDouble as ^ #} pyPtr + imag <- {# call PyComplex_ImagAsDouble as ^ #} pyPtr + return $ realToFrac real C.:+ realToFrac imag diff --git a/lib/CPython/Types/Dictionary.chs b/lib/CPython/Types/Dictionary.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Dictionary.chs @@ -0,0 +1,183 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Dictionary + ( Dictionary + , dictionaryType + , new + , clear + , contains + , copy + , getItem + , setItem + , deleteItem + , items + , keys + , values + , size + , merge + , update + , mergeFromSeq2 + ) where +import CPython.Internal hiding (new) + +#include + +instance Concrete Dictionary where + concreteType _ = dictionaryType + +{# fun pure hscpython_PyDict_Type as dictionaryType + {} -> `Type' peekStaticObject* #} + +{# fun PyDict_New as new + {} -> `Dictionary' stealObject* #} + +-- newProxy + +-- | Empty an existing dictionary of all key-value pairs. +-- +{# fun PyDict_Clear as clear + { withObject* `Dictionary' + } -> `()' id #} + +-- | Determine if a dictionary contains /key/. If an item in the dictionary +-- matches /key/, return 'True', otherwise return 'False'. On error, throws +-- an exception. This is equivalent to the Python expression @key in d@. +-- +{# fun PyDict_Contains as contains + `Object key' => + { withObject* `Dictionary' + , withObject* `key' + } -> `Bool' checkBoolReturn* #} + +-- | Return a new dictionary that contains the same key-value pairs as the +-- old dictionary. +-- +{# fun PyDict_Copy as copy + { withObject* `Dictionary' + } -> `Dictionary' stealObject* #} + +-- | Return the object from a dictionary which has a key /key/. Return +-- 'Nothing' if the key is not present. +-- +getItem :: Object key => Dictionary -> key -> IO (Maybe SomeObject) +getItem dict key = + withObject dict $ \dict' -> + withObject key $ \key' -> do + {# call PyErr_Clear as ^ #} + raw <- {# call PyDict_GetItemWithError as ^ #} dict' key' + if raw /= nullPtr + then Just `fmap` peekObject raw + else do + exc <- {# call PyErr_Occurred as ^ #} + exceptionIf $ exc /= nullPtr + return Nothing + +-- getItemString + +-- | Inserts /value/ into a dictionary with a key of /key/. /key/ must be +-- hashable; if it isn’t, throws @TypeError@. +-- +{# fun PyDict_SetItem as setItem + `(Object key, Object value)' => + { withObject* `Dictionary' + , withObject* `key' + , withObject* `value' + } -> `()' checkStatusCode* #} + +-- setItemString + +-- | Remove the entry in a dictionary with key /key/. /key/ must be hashable; +-- if it isn’t, throws @TypeError@. +-- +{# fun PyDict_DelItem as deleteItem + `Object key' => + { withObject* `Dictionary' + , withObject* `key' + } -> `()' checkStatusCode* #} + +-- deleteItemString + +-- | Return a 'List' containing all the items in the dictionary, as in +-- the Python method @dict.items()@. +-- +{# fun PyDict_Items as items + { withObject* `Dictionary' + } -> `List' stealObject* #} + +-- | Return a 'List' containing all the keys in the dictionary, as in +-- the Python method @dict.keys()@. +-- +{# fun PyDict_Keys as keys + { withObject* `Dictionary' + } -> `List' stealObject* #} + +-- | Return a 'List' containing all the values in the dictionary, as in +-- the Python method @dict.values()@. +-- +{# fun PyDict_Values as values + { withObject* `Dictionary' + } -> `List' stealObject* #} + +-- | Return the number of items in the dictionary. This is equivalent to +-- @len(d)@. +{# fun PyDict_Size as size + { withObject* `Dictionary' + } -> `Integer' checkIntReturn* #} + +-- next + +-- | Iterate over mapping object /b/ adding key-value pairs to a dictionary. +-- /b/ may be a dictionary, or any object supporting 'keys' and 'getItem'. +-- If the third parameter is 'True', existing pairs in will be replaced if a +-- matching key is found in /b/, otherwise pairs will only be added if there +-- is not already a matching key. +-- +{# fun PyDict_Merge as merge + `Mapping b' => + { withObject* `Dictionary' + , withObject* `b' + , `Bool' + } -> `()' checkStatusCode* #} + +-- | This is the same as @(\\a b -> 'merge' a b True)@ in Haskell, or +-- @a.update(b)@ in Python. +-- +{# fun PyDict_Update as update + `Mapping b' => + { withObject* `Dictionary' + , withObject* `b' + } -> `()' checkStatusCode* #} + +-- | Update or merge into a dictionary, from the key-value pairs in /seq2/. +-- /seq2/ must be an iterable object producing iterable objects of length 2, +-- viewed as key-value pairs. In case of duplicate keys, the last wins if +-- the third parameter is 'True', otherwise the first wins. Equivalent +-- Python: +-- +-- @ +-- def mergeFromSeq2(a, seq2, override): +-- for key, value in seq2: +-- if override or key not in a: +-- a[key] = value +-- @ +-- +{# fun PyDict_MergeFromSeq2 as mergeFromSeq2 + `Object seq2' => + { withObject* `Dictionary' + , withObject* `seq2' + , `Bool' + } -> `()' checkStatusCode* #} diff --git a/lib/CPython/Types/Exception.chs b/lib/CPython/Types/Exception.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Exception.chs @@ -0,0 +1,25 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Exception + ( Exception + , exceptionType + , exceptionValue + , exceptionTraceback + ) where +import CPython.Internal + +#include diff --git a/lib/CPython/Types/Float.chs b/lib/CPython/Types/Float.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Float.chs @@ -0,0 +1,46 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Float + ( Float + , floatType + , toFloat + , fromFloat + ) where +import Prelude hiding (Float) +import CPython.Internal + +#include + +newtype Float = Float (ForeignPtr Float) + +instance Object Float where + toObject (Float x) = SomeObject x + fromForeignPtr = Float + +instance Concrete Float where + concreteType _ = floatType + +{# fun pure hscpython_PyFloat_Type as floatType + {} -> `Type' peekStaticObject* #} + +{# fun PyFloat_FromDouble as toFloat + { realToFrac `Double' + } -> `Float' stealObject* #} + +{# fun PyFloat_AsDouble as fromFloat + { withObject* `Float' + } -> `Double' realToFrac #} diff --git a/lib/CPython/Types/Function.chs b/lib/CPython/Types/Function.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Function.chs @@ -0,0 +1,130 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Function + ( Function + , functionType + , new + , getCode + , getGlobals + , getModule + , getDefaults + , setDefaults + , getClosure + , setClosure + , getAnnotations + , setAnnotations + ) where +import CPython.Internal hiding (new) +import CPython.Types.Code (Code) +import qualified CPython.Constants as Const + +#include + +newtype Function = Function (ForeignPtr Function) + +instance Object Function where + toObject (Function x) = SomeObject x + fromForeignPtr = Function + +instance Concrete Function where + concreteType _ = functionType + +{# fun pure hscpython_PyFunction_Type as functionType + {} -> `Type' peekStaticObject* #} + +-- | Return a new function associated with the given code object. The second +-- parameter will be used as the globals accessible to the function. +-- +-- The function's docstring, name, and @__module__@ are retrieved from the +-- code object. The parameter defaults and closure are set to 'Nothing'. +-- +{# fun PyFunction_New as new + { withObject* `Code' + , withObject* `Dictionary' + } -> `Function' stealObject* #} + +-- | Return the code object associated with a function. +-- +{# fun PyFunction_GetCode as getCode + { withObject* `Function' + } -> `Code' peekObject* #} + +-- | Return the globals dictionary associated with a function. +-- +{# fun PyFunction_GetGlobals as getGlobals + { withObject* `Function' + } -> `Dictionary' peekObject* #} + +-- | Return the @__module__@ attribute of a function. This is normally +-- a 'Unicode' containing the module name, but can be set to any other +-- object by Python code. +-- +{# fun PyFunction_GetModule as getModule + { withObject* `Function' + } -> `SomeObject' peekObject* #} + +withNullableObject :: Object obj => Maybe obj -> (Ptr a -> IO b) -> IO b +withNullableObject Nothing io = do + none <- Const.none + withObject none io +withNullableObject (Just obj) io = withObject obj io + +peekNullableObject :: Object obj => Ptr a -> IO (Maybe obj) +peekNullableObject = maybePeek peekObject + +-- | Return the default parameter values for a function. This can be a tuple +-- or 'Nothing'. +-- +{# fun PyFunction_GetDefaults as getDefaults + { withObject* `Function' + } -> `Maybe Tuple' peekNullableObject* #} + +-- | Set the default values for a function. +-- +{# fun PyFunction_SetDefaults as setDefaults + { withObject* `Function' + , withNullableObject* `Maybe Tuple' + } -> `()' checkStatusCode* #} + +-- | Return the closure associated with a function. This can be 'Nothing', +-- or a tuple of 'Cell's. +-- +{# fun PyFunction_GetClosure as getClosure + { withObject* `Function' + } -> `Maybe Tuple' peekNullableObject* #} + +-- | Set the closure associated with a function. The tuple should contain +-- 'Cell's. +-- +{# fun PyFunction_SetClosure as setClosure + { withObject* `Function' + , withNullableObject* `Maybe Tuple' + } -> `()' checkStatusCode* #} + +-- | Return the annotations for a function. This can be a mutable dictionary, +-- or 'Nothing'. +-- +{# fun PyFunction_GetAnnotations as getAnnotations + { withObject* `Function' + } -> `Maybe Dictionary' peekNullableObject* #} + +-- | Set the annotations for a function object. +-- +{# fun PyFunction_SetAnnotations as setAnnotations + { withObject* `Function' + , withNullableObject* `Maybe Dictionary' + } -> `()' checkStatusCode* #} diff --git a/lib/CPython/Types/InstanceMethod.chs b/lib/CPython/Types/InstanceMethod.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/InstanceMethod.chs @@ -0,0 +1,46 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.InstanceMethod + ( InstanceMethod + , instanceMethodType + , new + , function + ) where +import CPython.Internal hiding (new) + +#include + +newtype InstanceMethod = InstanceMethod (ForeignPtr InstanceMethod) + +instance Object InstanceMethod where + toObject (InstanceMethod x) = SomeObject x + fromForeignPtr = InstanceMethod + +instance Concrete InstanceMethod where + concreteType _ = instanceMethodType + +{# fun pure hscpython_PyInstanceMethod_Type as instanceMethodType + {} -> `Type' peekStaticObject* #} + +{# fun PyInstanceMethod_New as new + `Object func' => + { withObject* `func' + } -> `InstanceMethod' stealObject* #} + +{# fun PyInstanceMethod_Function as function + { withObject* `InstanceMethod' + } -> `SomeObject' peekObject* #} diff --git a/lib/CPython/Types/Integer.chs b/lib/CPython/Types/Integer.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Integer.chs @@ -0,0 +1,63 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Integer + ( Integer + , integerType + , toInteger + , fromInteger + ) where +import Prelude hiding (Integer, toInteger, fromInteger) +import qualified Prelude as Prelude +import qualified Data.Text as T +import CPython.Internal +import qualified CPython.Types.Unicode as U +import qualified CPython.Protocols.Object as O + +#include + +newtype Integer = Integer (ForeignPtr Integer) + +instance Object Integer where + toObject (Integer x) = SomeObject x + fromForeignPtr = Integer + +instance Concrete Integer where + concreteType _ = integerType + +{# fun pure hscpython_PyLong_Type as integerType + {} -> `Type' peekStaticObject* #} + +toInteger :: Prelude.Integer -> IO Integer +toInteger int = do + let longlong = fromIntegral int + let [_, min', max'] = [longlong, minBound, maxBound] + stealObject =<< if Prelude.toInteger min' < int && int < Prelude.toInteger max' + then {# call PyLong_FromLongLong as ^ #} longlong + else withCString (show int) $ \cstr -> + {# call PyLong_FromString as ^ #} cstr nullPtr 10 + +fromInteger :: Integer -> IO Prelude.Integer +fromInteger py = do + (long, overflow) <- (withObject py $ \pyPtr -> + alloca $ \overflowPtr -> do + poke overflowPtr 0 + long <- {# call PyLong_AsLongAndOverflow as ^ #} pyPtr overflowPtr + overflow <- peek overflowPtr + return (long, overflow)) + if overflow == 0 + then return $ Prelude.toInteger long + else fmap (read . T.unpack) $ U.fromUnicode =<< O.string py diff --git a/lib/CPython/Types/Iterator.chs b/lib/CPython/Types/Iterator.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Iterator.chs @@ -0,0 +1,78 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Iterator + ( SequenceIterator + , sequenceIteratorType + , sequenceIteratorNew + + , CallableIterator + , callableIteratorType + , callableIteratorNew + ) where +import CPython.Internal + +#include + +newtype SequenceIterator = SequenceIterator (ForeignPtr SequenceIterator) + +instance Iterator SequenceIterator where + toIterator = unsafeCastToIterator + +instance Object SequenceIterator where + toObject (SequenceIterator x) = SomeObject x + fromForeignPtr = SequenceIterator + +instance Concrete SequenceIterator where + concreteType _ = sequenceIteratorType + +newtype CallableIterator = CallableIterator (ForeignPtr CallableIterator) + +instance Iterator CallableIterator where + toIterator = unsafeCastToIterator + +instance Object CallableIterator where + toObject (CallableIterator x) = SomeObject x + fromForeignPtr = CallableIterator + +instance Concrete CallableIterator where + concreteType _ = callableIteratorType + +{# fun pure hscpython_PySeqIter_Type as sequenceIteratorType + {} -> `Type' peekStaticObject* #} + +{# fun pure hscpython_PyCallIter_Type as callableIteratorType + {} -> `Type' peekStaticObject* #} + +-- | Return an 'Iterator' that works with a general sequence object, /seq/. +-- The iteration ends when the sequence raises @IndexError@ for the +-- subscripting operation. +-- +{# fun PySeqIter_New as sequenceIteratorNew + `Sequence seq' => + { withObject* `seq' + } -> `SequenceIterator' stealObject* #} + +-- | Return a new 'Iterator'. The first parameter, /callable/, can be any +-- Python callable object that can be called with no parameters; each call +-- to it should return the next item in the iteration. When /callable/ +-- returns a value equal to /sentinel/, the iteration will be terminated. +-- +{# fun PyCallIter_New as callableIteratorNew + `(Object callable, Object sentinel)' => + { withObject* `callable' + , withObject* `sentinel' + } -> `CallableIterator' stealObject* #} diff --git a/lib/CPython/Types/List.chs b/lib/CPython/Types/List.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/List.chs @@ -0,0 +1,160 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.List + ( List + , listType + , toList + , iterableToList + , fromList + , length + , getItem + , setItem + , insert + , append + , getSlice + , setSlice + , sort + , reverse + , toTuple + ) where +import Prelude hiding (reverse, length) +import CPython.Internal hiding (new) +import qualified CPython.Types.Tuple as T + +#include + +instance Concrete List where + concreteType _ = listType + +{# fun pure hscpython_PyList_Type as listType + {} -> `Type' peekStaticObject* #} + +toList :: [SomeObject] -> IO List +toList xs = + mapWith withObject xs $ \ptrs -> + withArrayLen ptrs $ \count array -> + {# call hscpython_poke_list #} (fromIntegral count) array + >>= stealObject + +-- | Convert any object implementing the iterator protocol to a 'List'. +-- +iterableToList :: Object iter => iter -> IO List +iterableToList iter = do + raw <- callObjectRaw listType =<< T.toTuple [toObject iter] + return $ unsafeCast raw + +fromList :: List -> IO [SomeObject] +fromList py = + withObject py $ \pyPtr -> + ({# call PyList_Size as ^ #} pyPtr >>=) $ \size -> + let size' = fromIntegral size :: Int in + withArray (replicate size' nullPtr) $ \ptrs -> + {# call hscpython_peek_list #} pyPtr size ptrs >> + peekArray size' ptrs >>= mapM peekObject + +{# fun PyList_Size as length + { withObject* `List' + } -> `Integer' checkIntReturn* #} + +-- | Returns the object at a given position in the list. The position must be +-- positive; indexing from the end of the list is not supported. If the +-- position is out of bounds, throws an @IndexError@ exception. +-- +{# fun PyList_GetItem as getItem + { withObject* `List' + , fromIntegral `Integer' + } -> `SomeObject' peekObject* #} + +-- | Set the item at a given index. +-- +setItem :: Object o => List -> Integer -> o -> IO () +setItem self index x = + withObject self $ \selfPtr -> + withObject x $ \xPtr -> do + incref xPtr + {# call PyList_SetItem as ^ #} selfPtr (fromIntegral index) xPtr + >>= checkStatusCode + +-- | Inserts /item/ into the list in front of the given index. Throws an +-- exception if unsuccessful. Analogous to @list.insert(index, item)@. +-- +{# fun PyList_Insert as insert + `Object item' => + { withObject* `List' + , fromIntegral `Integer' + , withObject* `item' + } -> `()' checkStatusCode* #} + +-- | Append /item/ to the end of th list. Throws an exception if unsuccessful. +-- Analogous to @list.append(item)@. +-- +{# fun PyList_Append as append + `Object item' => + { withObject* `List' + , withObject* `item' + } -> `()' checkStatusCode* #} + +-- | Return a list of the objects in list containing the objects between +-- the given indexes. Throws an exception if unsuccessful. Analogous to +-- @list[low:high]@. Negative indices, as when slicing from Python, are not +-- supported. +-- +{# fun PyList_GetSlice as getSlice + { withObject* `List' + , fromIntegral `Integer' + , fromIntegral `Integer' + } -> `List' stealObject* #} + +-- | Sets the slice of a list between /low/ and /high/ to the contents of +-- a replacement list. Analogous to @list[low:high] = replacement@. The +-- replacement may be 'Nothing', indicating the assignment of an empty list +-- (slice deletion). Negative indices, as when slicing from Python, are not +-- supported. +-- +setSlice + :: List + -> Integer -- ^ Low + -> Integer -- ^ High + -> Maybe List -- ^ Replacement + -> IO () +setSlice self low high items = let + low' = fromIntegral low + high' = fromIntegral high in + withObject self $ \selfPtr -> + maybeWith withObject items $ \itemsPtr -> do + {# call PyList_SetSlice as ^ #} selfPtr low' high' itemsPtr + >>= checkStatusCode + +-- | Sort the items of a list in place. This is equivalent to @list.sort()@. +-- +{# fun PyList_Sort as sort + { withObject* `List' + } -> `()' checkStatusCode* #} + +-- | Reverses the items of a list in place. This is equivalent to +-- @list.reverse()@. +-- +{# fun PyList_Reverse as reverse + { withObject* `List' + } -> `()' checkStatusCode* #} + +-- | Return a new 'Tuple' containing the contents of a list; equivalent to +-- @tuple(list)@. +-- +{# fun PyList_AsTuple as toTuple + { withObject* `List' + } -> `Tuple' stealObject* #} diff --git a/lib/CPython/Types/Method.chs b/lib/CPython/Types/Method.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Method.chs @@ -0,0 +1,52 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Method + ( Method + , methodType + , new + , function + , self + ) where +import CPython.Internal hiding (new) + +#include + +newtype Method = Method (ForeignPtr Method) + +instance Object Method where + toObject (Method x) = SomeObject x + fromForeignPtr = Method + +instance Concrete Method where + concreteType _ = methodType + +{# fun pure hscpython_PyMethod_Type as methodType + {} -> `Type' peekStaticObject* #} + +{# fun PyMethod_New as new + `(Object func, Object self)' => + { withObject* `func' + , withObject* `self' + } -> `Method' stealObject* #} + +{# fun PyMethod_Function as function + { withObject* `Method' + } -> `SomeObject' peekObject* #} + +{# fun PyMethod_Self as self + { withObject* `Method' + } -> `SomeObject' peekObject* #} diff --git a/lib/CPython/Types/Module.chs b/lib/CPython/Types/Module.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Module.chs @@ -0,0 +1,133 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Module + ( Module + , moduleType + , new + , getDictionary + , getName + , getFilename + , addObject + , addIntegerConstant + , addTextConstant + , importModule + , reload + ) where +import Prelude hiding (toInteger) +import Data.Text (Text) +import CPython.Internal hiding (new) +import CPython.Types.Integer (toInteger) +import CPython.Types.Unicode (toUnicode) + +#include + +newtype Module = Module (ForeignPtr Module) + +instance Object Module where + toObject (Module x) = SomeObject x + fromForeignPtr = Module + +instance Concrete Module where + concreteType _ = moduleType + +{# fun pure hscpython_PyModule_Type as moduleType + {} -> `Type' peekStaticObject* #} + +-- | Return a new module object with the @__name__@ attribute set. Only the +-- module’s @__doc__@ and @__name__@ attributes are filled in; the +-- caller is responsible for providing a @__file__@ attribute. +-- +{# fun PyModule_New as new + { withText* `Text' + } -> `Module' stealObject* #} + +-- | Return the dictionary object that implements a module’s namespace; +-- this object is the same as the @__dict__@ attribute of the module. This +-- computation never fails. It is recommended extensions use other +-- computations rather than directly manipulate a module’s @__dict__@. +-- +{# fun PyModule_GetDict as getDictionary + { withObject* `Module' + } -> `Dictionary' peekObject* #} + +-- | Returns a module’s @__name__@ value. If the module does not +-- provide one, or if it is not a string, throws @SystemError@. +-- +getName :: Module -> IO Text +getName py = + withObject py $ \py' -> do + raw <- {# call PyModule_GetName as ^ #} py' + exceptionIf $ raw == nullPtr + peekText raw + +-- | Returns the name of the file from which a module was loaded using the +-- module’s @__file__@ attribute. If this is not defined, or if it is +-- not a string, throws @SystemError@. +-- +getFilename :: Module -> IO Text +getFilename py = + withObject py $ \py' -> do + raw <- {# call PyModule_GetFilename as ^ #} py' + exceptionIf $ raw == nullPtr + peekText raw + +-- | Add an object to a module with the given name. This is a convenience +-- computation which can be used from the module’s initialization +-- computation. +-- +addObject :: Object value => Module -> Text -> value -> IO () +addObject py name val = + withObject py $ \py' -> + withText name $ \name' -> + withObject val $ \val' -> + incref val' >> + {# call PyModule_AddObject as ^ #} py' name' val' + >>= checkStatusCode + +-- | Add an integer constant to a module. This convenience computation can be +-- used from the module’s initialization computation. +-- +addIntegerConstant :: Module -> Text -> Integer -> IO () +addIntegerConstant m name value = toInteger value >>= addObject m name + +-- | Add a string constant to a module. This convenience computation can be +-- used from the module’s initialization computation. +-- +addTextConstant :: Module -> Text -> Text -> IO () +addTextConstant m name value = toUnicode value >>= addObject m name + +-- | This is a higher-level interface that calls the current “import +-- hook” (with an explicit level of @0@, meaning absolute import). It +-- invokes the @__import__()@ computation from the @__builtins__@ of the +-- current globals. This means that the import is done using whatever import +-- hooks are installed in the current environment. +-- +-- This computation always uses absolute imports. +-- +importModule :: Text -> IO Module +importModule name = do + pyName <- toUnicode name + withObject pyName $ \namePtr -> + {# call PyImport_Import as ^ #} namePtr + >>= stealObject + +-- | Reload a module. If an error occurs, an exception is thrown and the old +-- module still exists. +-- +{# fun PyImport_ReloadModule as reload + { withObject* `Module' + } -> `Module' stealObject* #} diff --git a/lib/CPython/Types/Set.chs b/lib/CPython/Types/Set.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Set.chs @@ -0,0 +1,156 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | Any functionality not listed below is best accessed using the either +-- the 'Object' protocol (including 'callMethod', 'richCompare', 'hash', +-- 'repr', 'isTrue', and 'getIter') or the 'Number' protocol (including 'and', +-- 'subtract', 'or', 'xor', 'inPlaceAnd', 'inPlaceSubtract', 'inPlaceOr', +-- and 'inPlaceXor'). +-- +module CPython.Types.Set + ( AnySet + , Set + , FrozenSet + , setType + , frozenSetType + , toSet + , toFrozenSet + , iterableToSet + , iterableToFrozenSet + , fromSet + , size + , contains + , add + , discard + , pop + , clear + ) where +import CPython.Internal +import CPython.Types.Tuple (toTuple, iterableToTuple, fromTuple) + +#include + +class Object a => AnySet a + +newtype Set = Set (ForeignPtr Set) + +instance Object Set where + toObject (Set x) = SomeObject x + fromForeignPtr = Set + +instance Concrete Set where + concreteType _ = setType + +newtype FrozenSet = FrozenSet (ForeignPtr FrozenSet) + +instance Object FrozenSet where + toObject (FrozenSet x) = SomeObject x + fromForeignPtr = FrozenSet + +instance Concrete FrozenSet where + concreteType _ = frozenSetType + +instance AnySet Set +instance AnySet FrozenSet + +{# fun pure hscpython_PySet_Type as setType + {} -> `Type' peekStaticObject* #} + +{# fun pure hscpython_PyFrozenSet_Type as frozenSetType + {} -> `Type' peekStaticObject* #} + +toSet :: [SomeObject] -> IO Set +toSet xs = toTuple xs >>= iterableToSet + +toFrozenSet :: [SomeObject] -> IO FrozenSet +toFrozenSet xs = toTuple xs >>= iterableToFrozenSet + +-- | Return a new 'Set' from the contents of an iterable 'Object'. The object +-- may be 'Nothing' to create an empty set. Throws a @TypeError@ if the object +-- is not iterable. +-- +{# fun PySet_New as iterableToSet + `Object obj' => + { withObject* `obj' + } -> `Set' stealObject* #} + +-- | Return a new 'FrozenSet' from the contents of an iterable 'Object'. The +-- object may be 'Nothing' to create an empty frozen set. Throws a @TypeError@ +-- if the object is not iterable. +-- +{# fun PyFrozenSet_New as iterableToFrozenSet + `Object obj' => + { withObject* `obj' + } -> `FrozenSet' stealObject* #} + +fromSet :: AnySet set => set -> IO [SomeObject] +fromSet set = iterableToTuple set >>= fromTuple + +-- | Return the size of a 'Set' or 'FrozenSet'. +-- +{# fun PySet_Size as size + `AnySet set' => + { withObject* `set' + } -> `Integer' checkIntReturn* #} + +-- | Return 'True' if found, 'False' if not found. Unlike the Python +-- @__contains__()@ method, this computation does not automatically convert +-- unhashable 'Set's into temporary 'FrozenSet's. Throws a @TypeError@ if the +-- key is unhashable. +-- +{# fun PySet_Contains as contains + `(AnySet set, Object key)' => + { withObject* `set' + , withObject* `key' + } -> `Bool' checkBoolReturn* #} + +-- | Add /key/ to a 'Set'. Also works with 'FrozenSet' (like +-- 'CPython.Types.Tuple.setItem' it can be used to fill-in the values of +-- brand new 'FrozenSet's before they are exposed to other code). Throws a +-- @TypeError@ if the key is unhashable. Throws a @MemoryError@ if there is +-- no room to grow. +-- +{# fun PySet_Add as add + `(AnySet set, Object key)' => + { withObject* `set' + , withObject* `key' + } -> `()' checkStatusCode* #} + +-- | Return 'True' if found and removed, 'False' if not found (no action +-- taken). Does not throw @KeyError@ for missing keys. Throws a @TypeError@ +-- if /key/ is unhashable. Unlike the Python @discard()@ method, this +-- computation does not automatically convert unhashable sets into temporary +-- 'FrozenSet's. +-- +{# fun PySet_Discard as discard + `Object key' => + { withObject* `Set' + , withObject* `key' + } -> `Bool' checkBoolReturn* #} + +-- | Return an arbitrary object in the set, and removes the object from the +-- set. Throws @KeyError@ if the set is empty. +-- +{# fun PySet_Pop as pop + { withObject* `Set' + } -> `SomeObject' stealObject* #} + +-- | Remove all elements from a set. +-- +{# fun PySet_Clear as clear + { withObject* `Set' + } -> `()' checkStatusCode* #} diff --git a/lib/CPython/Types/Slice.chs b/lib/CPython/Types/Slice.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Slice.chs @@ -0,0 +1,73 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Slice + ( Slice + , sliceType + , new + , getIndices + ) where +import Prelude hiding (length) +import CPython.Internal hiding (new) + +#include + +newtype Slice = Slice (ForeignPtr Slice) + +instance Object Slice where + toObject (Slice x) = SomeObject x + fromForeignPtr = Slice + +instance Concrete Slice where + concreteType _ = sliceType + +{# fun pure hscpython_PySlice_Type as sliceType + {} -> `Type' peekStaticObject* #} + +-- | Return a new slice object with the given values. The /start/, /stop/, +-- and /step/ parameters are used as the values of the slice object +-- attributes of the same names. Any of the values may be 'Nothing', in which +-- case @None@ will be used for the corresponding attribute. +-- +new :: (Object start, Object stop, Object step) => Maybe start -> Maybe stop -> Maybe step -> IO Slice +new start stop step = + maybeWith withObject start $ \startPtr -> + maybeWith withObject stop $ \stopPtr -> + maybeWith withObject step $ \stepPtr -> + {# call PySlice_New as ^ #} startPtr stopPtr stepPtr + >>= stealObject + +-- | Retrieve the start, stop, step, and slice length from a 'Slice', +-- assuming a sequence of the given length. +-- +getIndices :: Slice + -> Integer -- ^ Sequence length + -> IO (Integer, Integer, Integer, Integer) +getIndices slice length = + withObject slice $ \slicePtr -> + let length' = fromIntegral length in + alloca $ \startPtr -> + alloca $ \stopPtr -> + alloca $ \stepPtr -> + alloca $ \sliceLenPtr -> do + {# call PySlice_GetIndicesEx as ^ #} + slicePtr length' startPtr stopPtr stepPtr sliceLenPtr + >>= checkStatusCode + start <- fmap toInteger $ peek startPtr + stop <- fmap toInteger $ peek stopPtr + step <- fmap toInteger $ peek stepPtr + sliceLen <- fmap toInteger $ peek sliceLenPtr + return (start, stop, step, sliceLen) diff --git a/lib/CPython/Types/Tuple.chs b/lib/CPython/Types/Tuple.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Tuple.chs @@ -0,0 +1,89 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Tuple + ( Tuple + , tupleType + , toTuple + , iterableToTuple + , fromTuple + , length + , getItem + , getSlice + , setItem + ) where +import Prelude hiding (length) +import CPython.Internal hiding (new) + +#include + +instance Concrete Tuple where + concreteType _ = tupleType + +{# fun pure hscpython_PyTuple_Type as tupleType + {} -> `Type' peekStaticObject* #} + +toTuple :: [SomeObject] -> IO Tuple +toTuple xs = + mapWith withObject xs $ \ptrs -> + withArrayLen ptrs $ \count array -> + {# call hscpython_poke_tuple #} (fromIntegral count) array + >>= stealObject + +-- | Convert any object implementing the iterator protocol to a 'Tuple'. +-- +iterableToTuple :: Object iter => iter -> IO Tuple +iterableToTuple iter = do + raw <- callObjectRaw tupleType =<< toTuple [toObject iter] + return $ unsafeCast raw + +fromTuple :: Tuple -> IO [SomeObject] +fromTuple py = + withObject py $ \pyPtr -> + ({# call PyTuple_Size as ^ #} pyPtr >>=) $ \size -> + let size' = fromIntegral size :: Int in + withArray (replicate size' nullPtr) $ \ptrs -> + {# call hscpython_peek_tuple #} pyPtr size ptrs >> + peekArray size' ptrs >>= mapM peekObject + +{# fun PyTuple_Size as length + { withObject* `Tuple' + } -> `Integer' checkIntReturn* #} + +-- | Return the object at a given index from a tuple, or throws @IndexError@ +-- if the index is out of bounds. +-- +{# fun PyTuple_GetItem as getItem + { withObject* `Tuple' + , fromIntegral `Integer' + } -> `SomeObject' peekObject* #} + +-- | Take a slice of a tuple from /low/ to /high/, and return it as a new +-- tuple. +-- +{# fun PyTuple_GetSlice as getSlice + { withObject* `Tuple' + , fromIntegral `Integer' + , fromIntegral `Integer' + } -> `Tuple' stealObject* #} + +setItem :: Object o => Tuple -> Integer -> o -> IO () +setItem self index x = + withObject self $ \selfPtr -> + withObject x $ \xPtr -> do + incref xPtr + {# call PyTuple_SetItem as ^ #} selfPtr (fromIntegral index) xPtr + >>= checkStatusCode diff --git a/lib/CPython/Types/Type.chs b/lib/CPython/Types/Type.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Type.chs @@ -0,0 +1,38 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Type + ( Type + , typeType + , isSubtype + ) where +import CPython.Internal + +#include + +instance Concrete Type where + concreteType _ = typeType + +{# fun pure hscpython_PyType_Type as typeType + {} -> `Type' peekStaticObject* #} + +-- | Returns 'True' if the first parameter is a subtype of the second +-- parameter. +-- +{# fun PyType_IsSubtype as isSubtype + { withObject* `Type' + , withObject* `Type' + } -> `Bool' #} diff --git a/lib/CPython/Types/Unicode.chs b/lib/CPython/Types/Unicode.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/Unicode.chs @@ -0,0 +1,326 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.Unicode + ( + -- * Unicode objects + Unicode + , Encoding + , ErrorHandling (..) + , unicodeType + , toUnicode + , fromUnicode + , length + , fromEncodedObject + , fromObject + , encode + , decode + + -- * Methods and slot functions + , append + , split + , splitLines + , translate + , join + , MatchDirection (..) + , tailMatch + , FindDirection (..) + , find + , count + , replace + , format + , contains + ) where +#include + +import Prelude hiding (length) +import Control.Exception (ErrorCall (..), throwIO) +import qualified Data.Text as T +#ifdef Py_UNICODE_WIDE +import Data.Char (chr, ord) +#else +import qualified Data.Text.Foreign as TF +#endif +import CPython.Internal +import CPython.Types.Bytes (Bytes) + +newtype Unicode = Unicode (ForeignPtr Unicode) + +instance Object Unicode where + toObject (Unicode x) = SomeObject x + fromForeignPtr = Unicode + +instance Concrete Unicode where + concreteType _ = unicodeType + +type Encoding = T.Text +data ErrorHandling + = Strict + | Replace + | Ignore + deriving (Show, Eq) + +withErrors :: ErrorHandling -> (CString -> IO a) -> IO a +withErrors errors = withCString $ case errors of + Strict -> "strict" + Replace -> "replace" + Ignore -> "ignore" + +{# fun pure hscpython_PyUnicode_Type as unicodeType + {} -> `Type' peekStaticObject* #} + +toUnicode :: T.Text -> IO Unicode +toUnicode str = withBuffer toPython >>= stealObject where + toPython ptr len = let + len' = fromIntegral len + ptr' = castPtr ptr + in {# call hscpython_PyUnicode_FromUnicode #} ptr' len' +#ifdef Py_UNICODE_WIDE + ords = map (fromIntegral . ord) (T.unpack str) :: [CUInt] + withBuffer = withArrayLen ords . flip +#else + withBuffer = TF.useAsPtr str +#endif + +fromUnicode :: Unicode -> IO T.Text +fromUnicode obj = withObject obj $ \ptr -> do + buffer <- {# call hscpython_PyUnicode_AsUnicode #} ptr + size <- {# call hscpython_PyUnicode_GetSize #} ptr +#ifdef Py_UNICODE_WIDE + raw <- peekArray (fromIntegral size) buffer + return . T.pack $ map (chr . fromIntegral) raw +#else + TF.fromPtr (castPtr buffer) (fromIntegral size) +#endif + +{# fun hscpython_PyUnicode_GetSize as length + { withObject* `Unicode' + } -> `Integer' checkIntReturn* #} + +-- | Coerce an encoded object /obj/ to an Unicode object. +-- +-- 'Bytes' and other char buffer compatible objects are decoded according to +-- the given encoding and error handling mode. +-- +-- All other objects, including 'Unicode' objects, cause a @TypeError@ to be +-- thrown. +-- +{# fun hscpython_PyUnicode_FromEncodedObject as fromEncodedObject + `Object obj' => + { withObject* `obj' + , withText* `Encoding' + , withErrors* `ErrorHandling' + } -> `Unicode' stealObject* #} + +-- | Shortcut for @'fromEncodedObject' \"utf-8\" 'Strict'@ +-- +fromObject :: Object obj => obj -> IO Unicode +fromObject obj = fromEncodedObject obj (T.pack "utf-8") Strict + +-- | Encode a 'Unicode' object and return the result as 'Bytes' object. +-- The encoding and error mode have the same meaning as the parameters of +-- the the @str.encode()@ method. The codec to be used is looked up using +-- the Python codec registry. +-- +{# fun hscpython_PyUnicode_AsEncodedString as encode + { withObject* `Unicode' + , withText* `Encoding' + , withErrors* `ErrorHandling' + } -> `Bytes' stealObject* #} + +-- | Create a 'Unicode' object by decoding a 'Bytes' object. The encoding and +-- error mode have the same meaning as the parameters of the the +-- @str.encode()@ method. The codec to be used is looked up using the Python +-- codec registry. +-- +decode :: Bytes -> Encoding -> ErrorHandling -> IO Unicode +decode bytes enc errors = + withObject bytes $ \bytesPtr -> + withText enc $ \encPtr -> + withErrors errors $ \errorsPtr -> + alloca $ \bufferPtr -> + alloca $ \lenPtr -> do + {# call PyBytes_AsStringAndSize as ^ #} bytesPtr bufferPtr lenPtr + >>= checkStatusCode + buffer <- peek bufferPtr + len <- peek lenPtr + {# call hscpython_PyUnicode_Decode #} buffer len encPtr errorsPtr + >>= stealObject + +{# fun hscpython_PyUnicode_Concat as append + { withObject* `Unicode' + , withObject* `Unicode' + } -> `Unicode' stealObject* #} + +-- | Split a string giving a 'List' of 'Unicode' objects. If the separator is +-- 'Nothing', splitting will be done at all whitespace substrings. Otherwise, +-- splits occur at the given separator. Separators are not included in the +-- resulting list. +-- +split + :: Unicode + -> Maybe Unicode -- ^ Separator + -> Maybe Integer -- ^ Maximum splits + -> IO List +split s sep maxsplit = + withObject s $ \sPtr -> + maybeWith withObject sep $ \sepPtr -> + let max' = maybe (- 1) fromInteger maxsplit in + {# call hscpython_PyUnicode_Split #} sPtr sepPtr max' + >>= stealObject + +-- | Split a 'Unicode' string at line breaks, returning a list of 'Unicode' +-- strings. CRLF is considered to be one line break. If the second parameter +-- is 'False', the line break characters are not included in the resulting +-- strings. +-- +{# fun hscpython_PyUnicode_Splitlines as splitLines + { withObject* `Unicode' + , `Bool' + } -> `List' stealObject* #} + +-- | Translate a string by applying a character mapping table to it. +-- +-- The mapping table must map Unicode ordinal integers to Unicode ordinal +-- integers or @None@ (causing deletion of the character). +-- +-- Mapping tables need only provide the @__getitem__()@ interface; +-- dictionaries and sequences work well. Unmapped character ordinals (ones +-- which cause a @LookupError@) are left untouched and are copied as-is. +-- +-- The error mode has the usual meaning for codecs. +-- +{# fun hscpython_PyUnicode_Translate as translate + `Object table' => + { withObject* `Unicode' + , withObject* `table' + , withErrors* `ErrorHandling' + } -> `Unicode' stealObject* #} + +-- | Join a sequence of strings using the given separator. +-- +{# fun hscpython_PyUnicode_Join as join + `Sequence seq' => + { withObject* `Unicode' + , withObject* `seq' + } -> `Unicode' stealObject* #} + +data MatchDirection = Prefix | Suffix + deriving (Show, Eq) + +-- | Return 'True' if the substring matches @string*[*start:end]@ at the +-- given tail end (either a 'Prefix' or 'Suffix' match), 'False' otherwise. +-- +tailMatch + :: Unicode -- ^ String + -> Unicode -- ^ Substring + -> Integer -- ^ Start + -> Integer -- ^ End + -> MatchDirection + -> IO Bool +tailMatch str substr start end dir = + withObject str $ \strPtr -> + withObject substr $ \substrPtr -> + let start' = fromInteger start in + let end' = fromInteger end in + let dir' = case dir of + Prefix -> -1 + Suffix -> 1 in + {# call hscpython_PyUnicode_Tailmatch #} strPtr substrPtr start' end' dir' + >>= checkBoolReturn + +data FindDirection = Forwards | Backwards + deriving (Show, Eq) + +-- | Return the first position of the substring in @string*[*start:end]@ +-- using the given direction. The return value is the index of the first +-- match; a value of 'Nothing' indicates that no match was found. +-- +find + :: Unicode -- ^ String + -> Unicode -- ^ Substring + -> Integer -- ^ Start + -> Integer -- ^ End + -> FindDirection + -> IO (Maybe Integer) +find str substr start end dir = + withObject str $ \strPtr -> + withObject substr $ \substrPtr -> do + let start' = fromInteger start + let end' = fromInteger end + let dir' = case dir of + Forwards -> 1 + Backwards -> -1 + cRes <- {# call hscpython_PyUnicode_Find #} strPtr substrPtr start' end' dir' + exceptionIf $ cRes == -2 + case cRes of + -1 -> return Nothing + x | x >= 0 -> return . Just . toInteger $ x + x -> throwIO . ErrorCall $ "Invalid return code: " ++ show x + +-- | Return the number of non-overlapping occurrences of the substring in +-- @string[start:end]@. +-- +count + :: Unicode -- ^ String + -> Unicode -- ^ Substring + -> Integer -- ^ Start + -> Integer -- ^ End + -> IO Integer +count str substr start end = + withObject str $ \str' -> + withObject substr $ \substr' -> + let start' = fromInteger start in + let end' = fromInteger end in + {# call hscpython_PyUnicode_Count #} str' substr' start' end' + >>= checkIntReturn + +-- | Replace occurrences of the substring with a given replacement. If the +-- maximum count is 'Nothing', replace all occurences. +-- +replace + :: Unicode -- ^ String + -> Unicode -- ^ Substring + -> Unicode -- ^ Replacement + -> Maybe Integer -- ^ Maximum count + -> IO Unicode +replace str substr replstr maxcount = + withObject str $ \strPtr -> + withObject substr $ \substrPtr -> + withObject replstr $ \replstrPtr -> + let maxcount' = case maxcount of + Nothing -> -1 + Just x -> fromInteger x in + {# call hscpython_PyUnicode_Replace #} strPtr substrPtr replstrPtr maxcount' + >>= stealObject + +-- | Return a new 'Unicode' object from the given format and args; this is +-- analogous to @format % args@. +-- +{# fun hscpython_PyUnicode_Format as format + { withObject* `Unicode' + , withObject* `Tuple' + } -> `Unicode' stealObject* #} + +-- | Check whether /element/ is contained in a string. +-- +-- /element/ has to coerce to a one element string. +-- +{# fun hscpython_PyUnicode_Contains as contains + `Object element' => + { withObject* `Unicode' + , withObject* `element' + } -> `Bool' checkBoolReturn* #} diff --git a/lib/CPython/Types/WeakReference.chs b/lib/CPython/Types/WeakReference.chs new file mode 100644 --- /dev/null +++ b/lib/CPython/Types/WeakReference.chs @@ -0,0 +1,73 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Types.WeakReference + ( Reference + , Proxy + , newReference + , newProxy + , getObject + ) where +import CPython.Internal + +#include + +newtype Reference = Reference (ForeignPtr Reference) +instance Object Reference where + toObject (Reference x) = SomeObject x + fromForeignPtr = Reference + +newtype Proxy = Proxy (ForeignPtr Proxy) +instance Object Proxy where + toObject (Proxy x) = SomeObject x + fromForeignPtr = Proxy + +-- | Return a weak reference for the object. This will always return a new +-- reference, but is not guaranteed to create a new object; an existing +-- reference object may be returned. The second parameter, /callback/, can +-- be a callable object that receives notification when /obj/ is garbage +-- collected; it should accept a single parameter, which will be the weak +-- reference object itself. If ob is not a weakly-referencable object, or if +-- /callback/ is not callable, this will throw a @TypeError@. +-- +newReference :: (Object obj, Object callback) => obj -> Maybe callback -> IO Reference +newReference obj cb = + withObject obj $ \objPtr -> + maybeWith withObject cb $ \cbPtr -> + {# call PyWeakref_NewRef as ^ #} objPtr cbPtr + >>= stealObject + +-- | Return a weak reference proxy for the object. This will always return a +-- new reference, but is not guaranteed to create a new object; an existing +-- proxy may be returned. The second parameter, /callback/, can be a callable +-- object that receives notification when /obj/ is garbage collected; it +-- should accept a single parameter, which will be the weak reference object +-- itself. If ob is not a weakly-referencable object, or if /callback/ is not +-- callable, this will throw a @TypeError@. +-- +newProxy :: (Object obj, Object callback) => obj -> Maybe callback -> IO Proxy +newProxy obj cb = + withObject obj $ \objPtr -> + maybeWith withObject cb $ \cbPtr -> + {# call PyWeakref_NewProxy as ^ #} objPtr cbPtr + >>= stealObject + +-- | Return the referenced object from a weak reference. If the referent is +-- no longer live, returns @None@. +-- +{# fun PyWeakref_GetObject as getObject + { withObject* `Reference' + } -> `SomeObject' peekObject* #}