{-# LINE 1 "lib/CPython/Types/Integer.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module CPython.Types.Integer
( Integer
, integerType
, toInteger
, fromInteger
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp
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 -> SomeObject
toObject (Integer x :: ForeignPtr Integer
x) = ForeignPtr Integer -> SomeObject
forall a. Object a => ForeignPtr a -> SomeObject
SomeObject ForeignPtr Integer
x
fromForeignPtr :: ForeignPtr Integer -> Integer
fromForeignPtr = ForeignPtr Integer -> Integer
Integer
instance Concrete Integer where
concreteType :: Integer -> Type
concreteType _ = Type
integerType
integerType :: (Type)
integerType =
C2HSImp.unsafePerformIO $
integerType'_ >>= \res ->
peekStaticObject res >>= \res' ->
return (res')
{-# LINE 45 "lib/CPython/Types/Integer.chs" #-}
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 :: Integer -> IO Integer
fromInteger py :: Integer
py = do
(long :: CLong
long, overflow :: CInt
overflow) <- (Integer -> (Ptr () -> IO (CLong, CInt)) -> IO (CLong, CInt)
forall obj a b. Object obj => obj -> (Ptr a -> IO b) -> IO b
withObject Integer
py ((Ptr () -> IO (CLong, CInt)) -> IO (CLong, CInt))
-> (Ptr () -> IO (CLong, CInt)) -> IO (CLong, CInt)
forall a b. (a -> b) -> a -> b
$ \pyPtr :: Ptr ()
pyPtr ->
(Ptr CInt -> IO (CLong, CInt)) -> IO (CLong, CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (CLong, CInt)) -> IO (CLong, CInt))
-> (Ptr CInt -> IO (CLong, CInt)) -> IO (CLong, CInt)
forall a b. (a -> b) -> a -> b
$ \overflowPtr :: Ptr CInt
overflowPtr -> do
Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
overflowPtr 0
CLong
long <- Ptr () -> Ptr CInt -> IO CLong
pyLongAsLongAndOverflow Ptr ()
pyPtr Ptr CInt
overflowPtr
CInt
overflow <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
overflowPtr
(CLong, CInt) -> IO (CLong, CInt)
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong
long, CInt
overflow))
if CInt
overflow CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ CLong -> Integer
forall a. Integral a => a -> Integer
Prelude.toInteger CLong
long
else (Text -> Integer) -> IO Text -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> (Text -> String) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (IO Text -> IO Integer) -> IO Text -> IO Integer
forall a b. (a -> b) -> a -> b
$ Unicode -> IO Text
U.fromUnicode (Unicode -> IO Text) -> IO Unicode -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Integer -> IO Unicode
forall self. Object self => self -> IO Unicode
O.string Integer
py
foreign import ccall unsafe "CPython/Types/Integer.chs.h hscpython_PyLong_Type"
integerType'_ :: (IO (C2HSImp.Ptr ()))
foreign import ccall safe "CPython/Types/Integer.chs.h PyLong_FromLongLong"
pyLongFromLongLong :: (C2HSImp.CLLong -> (IO (C2HSImp.Ptr ())))
foreign import ccall safe "CPython/Types/Integer.chs.h PyLong_FromString"
pyLongFromString :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ())))))
foreign import ccall safe "CPython/Types/Integer.chs.h PyLong_AsLongAndOverflow"
pyLongAsLongAndOverflow :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CLong)))