diff --git a/CPython/Internal.chs b/CPython/Internal.chs --- a/CPython/Internal.chs +++ b/CPython/Internal.chs @@ -56,10 +56,20 @@ , checkIntReturn -- * Other classes + -- ** Mapping , Mapping (..) , SomeMapping (..) + , unsafeCastToMapping + + -- ** Sequence , Sequence (..) , SomeSequence (..) + , unsafeCastToSequence + + -- ** Iterator + , Iterator (..) + , SomeIterator (..) + , unsafeCastToIterator ) where import Control.Applicative ((<$>)) import qualified Control.Exception as E @@ -208,7 +218,51 @@ class Object a => Mapping a where toMapping :: a -> SomeMapping +instance Object SomeMapping where + toObject (SomeMapping x) = SomeObject x + fromForeignPtr = SomeMapping + +instance Mapping SomeMapping where + toMapping = id + +unsafeCastToMapping :: Object a => a -> SomeMapping +unsafeCastToMapping x = case toObject x of + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeMapping + in SomeMapping ptr' + data SomeSequence = forall a. (Sequence a) => SomeSequence (ForeignPtr a) class Object a => Sequence a where toSequence :: a -> SomeSequence + +instance Object SomeSequence where + toObject (SomeSequence x) = SomeObject x + fromForeignPtr = SomeSequence + +instance Sequence SomeSequence where + toSequence = id + +unsafeCastToSequence :: Object a => a -> SomeSequence +unsafeCastToSequence x = case toObject x of + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeSequence + in SomeSequence ptr' + +data SomeIterator = forall a. (Iterator a) => SomeIterator (ForeignPtr a) + +class Object a => Iterator a where + toIterator :: a -> SomeIterator + +instance Object SomeIterator where + toObject (SomeIterator x) = SomeObject x + fromForeignPtr = SomeIterator + +instance Iterator SomeIterator where + toIterator = id + +unsafeCastToIterator :: Object a => a -> SomeIterator +unsafeCastToIterator x = case toObject x of + SomeObject ptr -> let + ptr' = castForeignPtr ptr :: ForeignPtr SomeIterator + in SomeIterator ptr' diff --git a/CPython/Protocols/Iterator.chs b/CPython/Protocols/Iterator.chs new file mode 100644 --- /dev/null +++ b/CPython/Protocols/Iterator.chs @@ -0,0 +1,50 @@ +-- Copyright (C) 2009 John Millikin +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module CPython.Protocols.Iterator + ( Iterator (..) + , SomeIterator + , castToIterator + , next + ) where +import CPython.Internal + +#include + +-- | Attempt to convert an object to a generic 'Iterator'. If the object does +-- not implement the iterator protocol, returns 'Nothing'. +-- +castToIterator :: Object a => a -> IO (Maybe SomeIterator) +castToIterator obj = + withObject obj $ \objPtr -> do + isIter <- fmap cToBool $ {# call hscpython_PyIter_Check as ^ #} objPtr + return $ if isIter + then Just $ unsafeCastToIterator obj + else Nothing + +-- | Return the next value from the iteration, or 'Nothing' if there are no +-- remaining items. +-- +next :: Iterator iter => iter -> IO (Maybe SomeObject) +next iter = + withObject iter $ \iterPtr -> do + raw <- {# call PyIter_Next as ^ #} iterPtr + if raw == nullPtr + then do + err <- {# call PyErr_Occurred as ^ #} + exceptionIf $ err /= nullPtr + return Nothing + else fmap Just $ stealObject raw diff --git a/CPython/Protocols/Mapping.chs b/CPython/Protocols/Mapping.chs --- a/CPython/Protocols/Mapping.chs +++ b/CPython/Protocols/Mapping.chs @@ -31,21 +31,8 @@ #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 = diff --git a/CPython/Protocols/Sequence.chs b/CPython/Protocols/Sequence.chs --- a/CPython/Protocols/Sequence.chs +++ b/CPython/Protocols/Sequence.chs @@ -45,13 +45,6 @@ #include -instance Object SomeSequence where - toObject (SomeSequence x) = SomeObject x - fromForeignPtr = SomeSequence - -instance Sequence SomeSequence where - toSequence = id - instance Sequence ByteArray where toSequence = unsafeCastToSequence @@ -66,12 +59,6 @@ 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'. diff --git a/CPython/Types.hs b/CPython/Types.hs --- a/CPython/Types.hs +++ b/CPython/Types.hs @@ -30,7 +30,6 @@ , CPython.Types.Integer.Integer , SequenceIterator , CallableIterator - , Iterator , List , Method , Module diff --git a/CPython/Types/Iterator.chs b/CPython/Types/Iterator.chs --- a/CPython/Types/Iterator.chs +++ b/CPython/Types/Iterator.chs @@ -15,26 +15,23 @@ -- {-# LANGUAGE ForeignFunctionInterface #-} module CPython.Types.Iterator - ( Iterator - , SequenceIterator + ( SequenceIterator , sequenceIteratorType , sequenceIteratorNew , CallableIterator , callableIteratorType , callableIteratorNew - - , next ) where import CPython.Internal #include -class Object a => Iterator a - newtype SequenceIterator = SequenceIterator (ForeignPtr SequenceIterator) -instance Iterator SequenceIterator +instance Iterator SequenceIterator where + toIterator = unsafeCastToIterator + instance Object SequenceIterator where toObject (SequenceIterator x) = SomeObject x fromForeignPtr = SequenceIterator @@ -44,7 +41,9 @@ newtype CallableIterator = CallableIterator (ForeignPtr CallableIterator) -instance Iterator CallableIterator +instance Iterator CallableIterator where + toIterator = unsafeCastToIterator + instance Object CallableIterator where toObject (CallableIterator x) = SomeObject x fromForeignPtr = CallableIterator @@ -58,7 +57,7 @@ {# fun pure hscpython_PyCallIter_Type as callableIteratorType {} -> `Type' peekStaticObject* #} --- | Return an iterator that works with a general sequence object, /seq/. +-- | Return an 'Iterator' that works with a general sequence object, /seq/. -- The iteration ends when the sequence raises @IndexError@ for the -- subscripting operation. -- @@ -67,7 +66,7 @@ { withObject* `seq' } -> `SequenceIterator' stealObject* #} --- | Return a new iterator. The first parameter, /callable/, can be any +-- | 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. @@ -77,17 +76,3 @@ { 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.cabal b/cpython.cabal --- a/cpython.cabal +++ b/cpython.cabal @@ -1,5 +1,5 @@ name: cpython -version: 3.1.1.0 +version: 3.1.2.0 synopsis: Bindings for libpython license: GPL-3 license-file: license.txt @@ -64,6 +64,7 @@ CPython.Types.Type CPython.Types.Unicode CPython.Types.WeakReference + CPython.Protocols.Iterator CPython.Protocols.Mapping CPython.Protocols.Number CPython.Protocols.Object diff --git a/hscpython-shim.c b/hscpython-shim.c --- a/hscpython-shim.c +++ b/hscpython-shim.c @@ -59,6 +59,9 @@ int hscpython_PyObject_TypeCheck (PyObject *o, PyTypeObject *type) { return PyObject_TypeCheck (o, type); } +int hscpython_PyIter_Check(PyObject *o) +{ return PyIter_Check(o); } + /* Types */ PyTypeObject *hscpython_PyType_Type () { return &PyType_Type; } diff --git a/hscpython-shim.h b/hscpython-shim.h --- a/hscpython-shim.h +++ b/hscpython-shim.h @@ -12,6 +12,7 @@ void hscpython_Py_DECREF (PyObject *); int hscpython_PyObject_DelAttr(PyObject *, PyObject *); int hscpython_PyObject_TypeCheck (PyObject *, PyTypeObject *); +int hscpython_PyIter_Check(PyObject *); enum HSCPythonComparisonEnum { HSCPYTHON_LT = Py_LT