diff --git a/CPython.chs b/CPython.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Constants.chs b/CPython/Constants.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Internal.chs b/CPython/Internal.chs new file mode 100644 --- /dev/null +++ b/CPython/Internal.chs @@ -0,0 +1,214 @@ +-- 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 (..) + , SomeMapping (..) + , Sequence (..) + , SomeSequence (..) + ) 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 + +data SomeSequence = forall a. (Sequence a) => SomeSequence (ForeignPtr a) + +class Object a => Sequence a where + toSequence :: a -> SomeSequence diff --git a/CPython/Protocols/Mapping.chs b/CPython/Protocols/Mapping.chs new file mode 100644 --- /dev/null +++ b/CPython/Protocols/Mapping.chs @@ -0,0 +1,102 @@ +-- 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 +import CPython.Types.Dictionary (Dictionary) + +#include + +instance Object SomeMapping where + toObject (SomeMapping x) = SomeObject x + fromForeignPtr = SomeMapping + +instance Mapping SomeMapping where + toMapping = id + +instance Mapping Dictionary where + toMapping = unsafeCastToMapping + +unsafeCastToMapping :: Object a => a -> SomeMapping +unsafeCastToMapping x = case toObject x of + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeMapping + in SomeMapping ptr' + +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 new file mode 100644 --- /dev/null +++ b/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/CPython/Protocols/Object.chs b/CPython/Protocols/Object.chs new file mode 100644 --- /dev/null +++ b/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' #} + +-- | 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 new file mode 100644 --- /dev/null +++ b/CPython/Protocols/Sequence.chs @@ -0,0 +1,202 @@ +-- 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 Object SomeSequence where + toObject (SomeSequence x) = SomeObject x + fromForeignPtr = SomeSequence + +instance Sequence SomeSequence where + toSequence = id + +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 + +unsafeCastToSequence :: Object a => a -> SomeSequence +unsafeCastToSequence x = case toObject x of + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeSequence + in SomeSequence ptr' + +-- | 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 new file mode 100644 --- /dev/null +++ b/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/CPython/System.chs b/CPython/System.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types.hs b/CPython/Types.hs new file mode 100644 --- /dev/null +++ b/CPython/Types.hs @@ -0,0 +1,118 @@ +-- 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 + , Float + , Function + , InstanceMethod + , Integer + , SequenceIterator + , CallableIterator + , Iterator + , 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 + , toInteger + , fromInteger + , toList + , iterableToList + , fromList + , toSet + , toFrozenSet + , iterableToSet + , iterableToFrozenSet + , fromSet + , CPython.Types.Tuple.toTuple + , iterableToTuple + , fromTuple + , toUnicode + , fromUnicode + ) where +import qualified Prelude as Prelude +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 new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Bytes.chs b/CPython/Types/Bytes.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Capsule.chs b/CPython/Types/Capsule.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Cell.chs b/CPython/Types/Cell.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Code.chs b/CPython/Types/Code.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Complex.chs b/CPython/Types/Complex.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Dictionary.chs b/CPython/Types/Dictionary.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Exception.chs b/CPython/Types/Exception.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Float.chs b/CPython/Types/Float.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Function.chs b/CPython/Types/Function.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/InstanceMethod.chs b/CPython/Types/InstanceMethod.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Integer.chs b/CPython/Types/Integer.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Iterator.chs b/CPython/Types/Iterator.chs new file mode 100644 --- /dev/null +++ b/CPython/Types/Iterator.chs @@ -0,0 +1,94 @@ +-- 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 + ( Iterator + , SequenceIterator + , sequenceIteratorType + , sequenceIteratorNew + + , CallableIterator + , callableIteratorType + , callableIteratorNew + + , next + ) where +import CPython.Internal +import CPython.Protocols.Sequence (Sequence) + +#include + +class Object a => Iterator a + +newtype SequenceIterator = SequenceIterator (ForeignPtr SequenceIterator) + +instance Iterator SequenceIterator +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 +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* #} + +-- | 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/Types/List.chs b/CPython/Types/List.chs new file mode 100644 --- /dev/null +++ b/CPython/Types/List.chs @@ -0,0 +1,161 @@ +-- 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 qualified Prelude as Prelude +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 new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Module.chs b/CPython/Types/Module.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Set.chs b/CPython/Types/Set.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Slice.chs b/CPython/Types/Slice.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Tuple.chs b/CPython/Types/Tuple.chs new file mode 100644 --- /dev/null +++ b/CPython/Types/Tuple.chs @@ -0,0 +1,90 @@ +-- 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 qualified Prelude as Prelude +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 new file mode 100644 --- /dev/null +++ b/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/CPython/Types/Unicode.chs b/CPython/Types/Unicode.chs new file mode 100644 --- /dev/null +++ b/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/CPython/Types/WeakReference.chs b/CPython/Types/WeakReference.chs new file mode 100644 --- /dev/null +++ b/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* #} diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cpython.cabal b/cpython.cabal new file mode 100644 --- /dev/null +++ b/cpython.cabal @@ -0,0 +1,66 @@ +name: cpython +version: 3.1.0 +synopsis: Bindings for libpython +license: GPL-3 +license-file: license.txt +author: John Millikin +maintainer: jmillikin@gmail.com +copyright: Copyright (c) John Millikin 2009, + (c) Python Software Foundation 2001-2009. +build-type: Simple +cabal-version: >=1.4 +category: Foreign +homepage: http://ianen.org/haskell/bindings/cpython/ +tested-with: GHC==6.10.1, GHC==6.10.4 +extra-source-files: hscpython-shim.h + +library + ghc-options: -Wall -fno-warn-orphans + build-depends: + base >=4 && < 5 + , bytestring + , text + + build-tools: + c2hs >= 0.15 + + exposed-modules: + CPython + CPython.Types + CPython.Types.ByteArray + CPython.Types.Bytes + CPython.Types.Capsule + CPython.Types.Cell + CPython.Types.Code + CPython.Types.Complex + CPython.Types.Dictionary + CPython.Types.Exception + CPython.Types.Float + CPython.Types.Function + CPython.Types.InstanceMethod + CPython.Types.Integer + CPython.Types.Iterator + CPython.Types.List + CPython.Types.Method + CPython.Types.Module + CPython.Types.Set + CPython.Types.Slice + CPython.Types.Tuple + CPython.Types.Type + CPython.Types.Unicode + CPython.Types.WeakReference + CPython.Protocols.Mapping + CPython.Protocols.Number + CPython.Protocols.Object + CPython.Protocols.Sequence + CPython.Constants + CPython.Reflection + CPython.System + + other-modules: + CPython.Internal + + c-sources: hscpython-shim.c + include-dirs: . + + pkgconfig-depends: python-3.1 diff --git a/hscpython-shim.c b/hscpython-shim.c new file mode 100644 --- /dev/null +++ b/hscpython-shim.c @@ -0,0 +1,244 @@ +/** + * 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); } + +/* 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 new file mode 100644 --- /dev/null +++ b/hscpython-shim.h @@ -0,0 +1,77 @@ +#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 *); + +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 **); diff --git a/license.txt b/license.txt new file mode 100644 --- /dev/null +++ b/license.txt @@ -0,0 +1,734 @@ +FORWARD +------------------------------------------------------------------------------- + +The source code for this library is copyrighted by John Millikin and licensed +under the GPL version 3 or greater, as described in the file headers. +However, much of the documentation is copyrighted by the Python Software +Foundation under the terms of the Python Software Foundation license, +version 2. Both licenses are reproduced below. + +------------------------------------------------------------------------------- + +PYTHON SOFTWARE FOUNDATION LICENSE VERSION 2 + +1. This LICENSE AGREEMENT is between the Python Software Foundation +("PSF"), and the Individual or Organization ("Licensee") accessing and +otherwise using this software ("Python") in source or binary form and +its associated documentation. + +2. Subject to the terms and conditions of this License Agreement, PSF hereby +grants Licensee a nonexclusive, royalty-free, world-wide license to reproduce, +analyze, test, perform and/or display publicly, prepare derivative works, +distribute, and otherwise use Python alone or in any derivative version, +provided, however, that PSF's License Agreement and PSF's notice of copyright, +i.e., "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Python +Software Foundation; All Rights Reserved" are retained in Python alone or in any +derivative version prepared by Licensee. + +3. In the event Licensee prepares a derivative work that is based on +or incorporates Python or any part thereof, and wants to make +the derivative work available to others as provided herein, then +Licensee hereby agrees to include in any such work a brief summary of +the changes made to Python. + +4. PSF is making Python available to Licensee on an "AS IS" +basis. PSF MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR +IMPLIED. BY WAY OF EXAMPLE, BUT NOT LIMITATION, PSF MAKES NO AND +DISCLAIMS ANY REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS +FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF PYTHON WILL NOT +INFRINGE ANY THIRD PARTY RIGHTS. + +5. PSF SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PYTHON +FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS +A RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PYTHON, +OR ANY DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF. + +6. This License Agreement will automatically terminate upon a material +breach of its terms and conditions. + +7. Nothing in this License Agreement shall be deemed to create any +relationship of agency, partnership, or joint venture between PSF and +Licensee. This License Agreement does not grant permission to use PSF +trademarks or trade name in a trademark sense to endorse or promote +products or services of Licensee, or any third party. + +8. By copying, installing or otherwise using Python, Licensee +agrees to be bound by the terms and conditions of this License +Agreement. + +------------------------------------------------------------------------------- + + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + 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 + (at your option) 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 . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +.