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.Protocols.Object as O
import qualified CPython.Types.Unicode as U
newtype Integer = Integer (ForeignPtr Integer)
instance Object Integer where
toObject (Integer x) = SomeObject x
fromForeignPtr = Integer
instance Concrete Integer where
concreteType _ = integerType
integerType :: Type
integerType =
unsafePerformIO $
let {res = integerType'_} in
peekStaticObject res >>= \res' ->
return (res')
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 pyLongFromLongLong longlong
else withCString (show int) $ \cstr ->
pyLongFromString cstr nullPtr 10
fromInteger :: Integer -> IO Prelude.Integer
fromInteger py = do
(long, overflow) <- (withObject py $ \pyPtr ->
alloca $ \overflowPtr -> do
poke overflowPtr 0
long <- pyLongAsLongAndOverflow 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
foreign import ccall unsafe "CPython/Types/Integer.chs.h hscpython_PyLong_Type"
integerType'_ :: (Ptr ())
foreign import ccall safe "CPython/Types/Integer.chs.h PyLong_FromLongLong"
pyLongFromLongLong :: (CLLong -> (IO (Ptr ())))
foreign import ccall safe "CPython/Types/Integer.chs.h PyLong_FromString"
pyLongFromString :: ((Ptr CChar) -> ((Ptr (Ptr CChar)) -> (CInt -> (IO (Ptr ())))))
foreign import ccall safe "CPython/Types/Integer.chs.h PyLong_AsLongAndOverflow"
pyLongAsLongAndOverflow :: ((Ptr ()) -> ((Ptr CInt) -> (IO CLong)))